diff options
Diffstat (limited to 'gcc/fortran')
30 files changed, 3061 insertions, 199 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 846186a3174..8ccf50acd08 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,7 +1,200 @@ +2005-04-04 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * intrinsic.texi: BES?? functions are not in the f95 standard. + +2005-04-03 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * intrinsic.texi: Document COS, EXP, LOG, LOG10, SIN, SQRT, TAN. + +2005-04-03 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * intrinsic.texi: Document BESJ0, BESJ1, BESJN, BESY0, BESY1, + BESYN, ATAN, COSH, ERF, ERC, SINH, TANH. + +2005-04-02 Steven G. Kargl <kargls@comcast.net> + + * intrinsic.texi: Document ALLOCATED, ANINT, ANY, ASIN; Fix typos. + +2005-03-30 Canqun Yang <canqun@nudt.edu.cn> + + * trans-common.c (create_common): Build RECORD_NODE for common blocks + contain no equivalence objects. + (add_equivalences): New argument saw_equiv. + (trans_common): New local variable saw_equiv. + (finish_equivalences): Add a local variable dummy, Always pass true + for the 3rd parameter to create_common. + +2005-03-29 Steven G. Kargl <kargls@comcast.net> + + * gfortran.h (option_t): Change d8, i8, r8 to flag_default_double, + flag_default_integer, flag_default_real + * invoke.texi: Update documentation + * lang.opt: Remove d8, i8, r8 definitions; Add fdefault-double-8 + fdefault-integer-8, and fdefault-real-8 definitions. + * options.c (gfc_init_options): Set option defaults + (gfc_handle_option): Handle command line options. + * trans-types.c (gfc_init_kinds): Use options. + +2005-03-27 Steven G. Kargl <kargls@comcast.net> + + * intrinsic.texi: Document AIMAG, AINT, ALL + +2005-03-25 Steven G. Kargl <kargls@comcast.net> + + * intrinsic.texi: Fix "make dvi" + +2005-03-24 Steven G. Kargl <kargls@comcast.net> + + * intrinsic.texi: New file. + * gfortran.texi: Include it; white space change; fix typo. + +2005-03-22 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill, + gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub, + gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename, + gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror, + gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub, + gfc_check_perror): new functions to check newly implemented + g77 intrinsics. + * gfortran.h: adding symbols for new intrinsics. + * intrinsic.c (add_functions): adding new intrinsics. + (add_subroutines): adding new intrinsics. + * intrinsic.h: prototype for all checking and resolving + functions. + * iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub, + gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill, + gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk, + gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub, + gfc_resolve_kill_sub, gfc_resolve_link_sub, + gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub, + gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub, + gfc_resolve_perror): new functions to resolve intrinsics. + * trans-intrinsic.c (gfc_conv_intrinsic_function): add case + for new symbols. + +2005-03-19 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + * dump-parse-tree.c (gfc_show_expr): Dump name of namespace + in which the variable is declared. + + PR fortran/18525 + * resolve.c (was_declared): Also check for dummy attribute. + +2005-03-19 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + * gfortran.h (arith): Remove ARITH_0TO0. + * arith.c (gfc_arith_error): Remove handling of ARITH_0TO0. + (gfc_arith_power): Remove special casing of zero to integral + power zero. + +2005-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * invoke.texi: Fix typos. + +2005-03-15 Feng Wang <fengwang@nudt.edu.cn> + + PR fortran/18827 + * io.c (resolve_tag): Add checking on assigned label. + (match_dt_format): Does not set symbol assign attribute. + * match.c (gfc_match_goto):Does not set symbol assign attribute. + * resolve.c (resolve_code): Add checking on assigned label. + * trans-common.c (build_field): Deals with common variable assigned + a label. + * trans-stmt.c (gfc_conv_label_variable): New function. + (gfc_trans_label_assign): Use it. + (gfc_trans_goto): Ditto. + * trans-io.c (set_string): Ditto. + * trans.h (gfc_conv_label_variable): Add prototype. + +2005-03-14 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/20467 + * symbol.c (check_conflict): A dummy argument can't be a statement + function. + +2005-03-13 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/16907 + * resolve.c (gfc_resolve_index): Allow REAL indices as an extension. + +2005-03-13 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/20323 + * resolve.c (gfc_resolve): Check if character lengths are + specification expressions. + +2005-03-12 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/20361 + * trans-array.c (gfc_stack_space_left): Remove unused variable. + (gfc_can_put_var_on_stack): Move to trans-decl.c, remove #if 0'ed + code. + * trans-array.h (gfc_stack_space_left, gfc_can_put_var_on_stack): + Remove declaration / prototype. + * trans-common.c (build_equiv_decl): Give union a name. Check if + it can be put on the stack. + * trans-decl.c (gfc_stack_space_left): Move function here. + (gfc_build_qualified_array): Fix comment typo. + * trans.h (gfc_put_var_on_stack): Add prototype. + +2005-03-05 Steven G. Kargl <kargls@comcast.net> + + PR fortran/19936 + * primary.c (match_complex_constant): Mangled complex constant may + be an implied do-loop. Give implied do-loop matcher a chance. + +2005-03-05 Steven G. Kargl <kargls@comcast.net> + + PR fortran/19754 + * resolve.c (compare_shapes): New function. + (resolve_operator): Use it. + +2005-03-04 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/19673 + * trans-expr.c (gfc_conv_function_call): Correctly dereference + argument from a pointer function also if it has a result clause. + +2005-03-04 Steven G. Kargl <kargls@comcast.net> + + * expr.c (gfc_copy_shape_excluding): Change && to ||. + +2005-03-04 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + * trans-intrinsic.c (gfc_get_symbol_for_expr): Fix comment typo, + clarify comment. + +2005-02-28 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + (port from g95) + + PR fortran/19479 + * simplify.c (gfc_simplify_bound): Rename to ... + (simplify_bound): ... this and overhaul. + +2005-02-28 Steven G. Kargl <kargl@gcc.gnu.org> + + * trans-intrinsic.c (gfc_conv_intrinsic_iargc): remove boolean argument. + (gfc_conv_intrinsic_function): update function calls + +2005-02-27 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/20058 + * trans-types.c (gfc_max_integer_kind): Declare + (gfc_init_kinds): Initialize it. + * gfortran.h (gfc_max_integer_kind): extern it. + * primary.c (match_boz_constant): Use it; remove gfortran extension + of kind suffixes on BOZ literal constants + 2005-02-24 Volker Reichelt <reichelt@igpm.rwth-aachen.de> * decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s). +2005-04-24 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + Unrevert previously reverted patch. Adding this fix: + * module.c (find_true_name): Deal with NULL module. + 2005-02-24 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> Revert yesterday's patch: diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index a219ed20675..b55713e571e 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -152,9 +152,6 @@ gfc_arith_error (arith code) case ARITH_DIV0: p = "Division by zero"; break; - case ARITH_0TO0: - p = "Indeterminate form 0 ** 0"; - break; case ARITH_INCOMMENSURATE: p = "Array operands are incommensurate"; break; @@ -989,33 +986,23 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) result = gfc_constant_result (op1->ts.type, op1->ts.kind, &op1->where); if (power == 0) - { /* Handle something to the zeroth power */ + { + /* Handle something to the zeroth power. Since we're dealing + with integral exponents, there is no ambiguity in the + limiting procedure used to determine the value of 0**0. */ switch (op1->ts.type) { case BT_INTEGER: - if (mpz_sgn (op1->value.integer) == 0) - rc = ARITH_0TO0; - else - mpz_set_ui (result->value.integer, 1); + mpz_set_ui (result->value.integer, 1); break; case BT_REAL: - if (mpfr_sgn (op1->value.real) == 0) - rc = ARITH_0TO0; - else - mpfr_set_ui (result->value.real, 1, GFC_RND_MODE); + mpfr_set_ui (result->value.real, 1, GFC_RND_MODE); break; case BT_COMPLEX: - if (mpfr_sgn (op1->value.complex.r) == 0 - && mpfr_sgn (op1->value.complex.i) == 0) - rc = ARITH_0TO0; - else - { - mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE); - mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); - } - + mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE); + mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); break; default: diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 7a971f20038..8fae4449fbf 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -575,6 +575,35 @@ gfc_check_char (gfc_expr * i, gfc_expr * kind) try +gfc_check_chdir (gfc_expr * dir) +{ + if (type_check (dir, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status) +{ + if (type_check (dir, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 1) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind) { if (numeric_check (x, 0) == FAILURE) @@ -1008,6 +1037,41 @@ gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size) try +gfc_check_kill (gfc_expr * pid, gfc_expr * sig) +{ + if (type_check (pid, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (type_check (sig, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_kill_sub (gfc_expr * pid, gfc_expr * sig, gfc_expr * status) +{ + if (type_check (pid, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (type_check (sig, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_kind (gfc_expr * x) { if (x->ts.type == BT_DERIVED) @@ -1039,6 +1103,76 @@ gfc_check_lbound (gfc_expr * array, gfc_expr * dim) try +gfc_check_link (gfc_expr * path1, gfc_expr * path2) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_link_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_symlnk (gfc_expr * path1, gfc_expr * path2) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_symlnk_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_logical (gfc_expr * a, gfc_expr * kind) { if (type_check (a, 0, BT_LOGICAL) == FAILURE) @@ -1454,6 +1588,41 @@ gfc_check_real (gfc_expr * a, gfc_expr * kind) try +gfc_check_rename (gfc_expr * path1, gfc_expr * path2) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_rename_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status) +{ + if (type_check (path1, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (path2, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_repeat (gfc_expr * x, gfc_expr * y) { if (type_check (x, 0, BT_CHARACTER) == FAILURE) @@ -1658,6 +1827,19 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim) try +gfc_check_sleep_sub (gfc_expr * seconds) +{ + if (type_check (seconds, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (seconds, 0) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies) { if (source->rank >= GFC_MAX_DIMENSIONS) @@ -2234,6 +2416,16 @@ gfc_check_etime_sub (gfc_expr * values, gfc_expr * time) try +gfc_check_gerror (gfc_expr * msg) +{ + if (type_check (msg, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status) { if (type_check (cwd, 0, BT_CHARACTER) == FAILURE) @@ -2253,6 +2445,16 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status) try +gfc_check_getlog (gfc_expr * msg) +{ + if (type_check (msg, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_exit (gfc_expr * status) { if (status == NULL) @@ -2285,6 +2487,45 @@ gfc_check_flush (gfc_expr * unit) try +gfc_check_hostnm (gfc_expr * name) +{ + if (type_check (name, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_hostnm_sub (gfc_expr * name, gfc_expr * status) +{ + if (type_check (name, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (scalar_check (status, 1) == FAILURE) + return FAILURE; + + if (type_check (status, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_perror (gfc_expr * string) +{ + if (type_check (string, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_umask (gfc_expr * mask) { if (type_check (mask, 0, BT_INTEGER) == FAILURE) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index f8df9dabb12..3df244cca71 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -409,6 +409,8 @@ gfc_show_expr (gfc_expr * p) break; case EXPR_VARIABLE: + if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name) + gfc_status ("%s:", p->symtree->n.sym->ns->proc_name->name); gfc_status ("%s", p->symtree->n.sym->name); gfc_show_ref (p->ref); break; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 5867f9bfaa5..f4a4b589b1f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -352,7 +352,7 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim) n = mpz_get_si (dim->value.integer); n--; /* Convert to zero based index */ - if (n < 0 && n >= rank) + if (n < 0 || n >= rank) return NULL; s = new_shape = gfc_get_shape (rank-1); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index adbccc11486..1e56920c73c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -181,7 +181,7 @@ extern mstring intrinsic_operators[]; /* Arithmetic results. */ typedef enum { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN, - ARITH_DIV0, ARITH_0TO0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC + ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC } arith; @@ -292,6 +292,7 @@ enum gfc_generic_isym_id GFC_ISYM_BTEST, GFC_ISYM_CEILING, GFC_ISYM_CHAR, + GFC_ISYM_CHDIR, GFC_ISYM_CMPLX, GFC_ISYM_COMMAND_ARGUMENT_COUNT, GFC_ISYM_CONJG, @@ -317,6 +318,7 @@ enum gfc_generic_isym_id GFC_ISYM_GETGID, GFC_ISYM_GETPID, GFC_ISYM_GETUID, + GFC_ISYM_HOSTNM, GFC_ISYM_IACHAR, GFC_ISYM_IAND, GFC_ISYM_IARGC, @@ -325,15 +327,18 @@ enum gfc_generic_isym_id GFC_ISYM_IBSET, GFC_ISYM_ICHAR, GFC_ISYM_IEOR, + GFC_ISYM_IERRNO, GFC_ISYM_INDEX, GFC_ISYM_INT, GFC_ISYM_IOR, GFC_ISYM_IRAND, GFC_ISYM_ISHFT, GFC_ISYM_ISHFTC, + GFC_ISYM_KILL, GFC_ISYM_LBOUND, GFC_ISYM_LEN, GFC_ISYM_LEN_TRIM, + GFC_ISYM_LINK, GFC_ISYM_LGE, GFC_ISYM_LGT, GFC_ISYM_LLE, @@ -359,6 +364,7 @@ enum gfc_generic_isym_id GFC_ISYM_PRODUCT, GFC_ISYM_RAND, GFC_ISYM_REAL, + GFC_ISYM_RENAME, GFC_ISYM_REPEAT, GFC_ISYM_RESHAPE, GFC_ISYM_RRSPACING, @@ -378,9 +384,12 @@ enum gfc_generic_isym_id GFC_ISYM_SR_KIND, GFC_ISYM_STAT, GFC_ISYM_SUM, + GFC_ISYM_SYMLNK, GFC_ISYM_SYSTEM, GFC_ISYM_TAN, GFC_ISYM_TANH, + GFC_ISYM_TIME, + GFC_ISYM_TIME8, GFC_ISYM_TRANSFER, GFC_ISYM_TRANSPOSE, GFC_ISYM_TRIM, @@ -1393,6 +1402,9 @@ typedef struct int warn_surprising; int warn_unused_labels; + int flag_default_double; + int flag_default_integer; + int flag_default_real; int flag_dollar_ok; int flag_underscoring; int flag_second_underscore; @@ -1404,9 +1416,7 @@ typedef struct int flag_repack_arrays; int q_kind; - int r8; - int i8; - int d8; + int warn_std; int allow_std; int warn_nonstd_intrinsics; @@ -1556,6 +1566,7 @@ void gfc_arith_done_1 (void); int gfc_validate_kind (bt, int, bool); extern int gfc_index_integer_kind; extern int gfc_default_integer_kind; +extern int gfc_max_integer_kind; extern int gfc_default_real_kind; extern int gfc_default_double_kind; extern int gfc_default_character_kind; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index c3242f7b5a3..9068cffdc76 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -109,25 +109,31 @@ the GNU Fortran 95 compiler. You can find in this manual how to invoke @ifset DEVELOPMENT @emph{Warning:} This document, and the compiler it describes, are still -under development. While efforts are made too keep it up-to-date it might +under development. While efforts are made to keep it up-to-date, it might not accurately reflect the status of the most recent @command{gfortran}. @end ifset +@comment +@comment When you add a new menu item, please keep the right hand +@comment aligned to the same column. Do not use tabs. This provides +@comment better formatting. +@comment @menu -* Copying:: GNU General Public License says - how you can copy and share GNU Fortran. +* Copying:: GNU General Public License says + how you can copy and share GNU Fortran. * GNU Free Documentation License:: - How you can copy and share this manual. -* Funding:: How to help assure continued work for free software. -* Getting Started:: What you should know about @command{gfortran}. -* GFORTRAN and GCC:: You can compile Fortran, C, or other programs. -* GFORTRAN and G77:: Why we choose to start from scratch. + How you can copy and share this manual. +* Funding:: How to help assure continued work for free software. +* Getting Started:: What you should know about @command{gfortran}. +* GFORTRAN and GCC:: You can compile Fortran, C, or other programs. +* GFORTRAN and G77:: Why we chose to start from scratch. * Invoking GFORTRAN:: Command options supported by @command{gfortran}. -* Project Status:: Status of @command{gfortran}, Roadmap, proposed extensions. -* Contributing:: Helping you can help. -* Standards:: Standards supported by @command{gfortran} -* Extensions:: Language extensions implemented by @command{gfortran} -* Index:: Index of this documentation. +* Project Status:: Status of @command{gfortran}, roadmap, proposed extensions. +* Contributing:: How you can help. +* Standards:: Standards supported by @command{gfortran} +* Extensions:: Language extensions implemented by @command{gfortran} +* Intrinsic Procedures:: Intrinsic procedures supported by @command{gfortran} +* Index:: Index of this documentation. @end menu @@ -369,7 +375,6 @@ because it was expected to be easier to maintain code we develop ourselves than to do a major overhaul of @command{g77} first, and then build a Fortran 95 compiler out of it. - @include invoke.texi @c --------------------------------------------------------------------- @@ -670,6 +675,7 @@ Examples of standard conforming code equivalent to the above example, are: DATA i,j,x /1,2,3*0.,1./ @end smallexample +@include intrinsic.texi @c --------------------------------------------------------------------- @c Contributing @c --------------------------------------------------------------------- diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ebf5cb2edda..7336e63d552 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1092,6 +1092,12 @@ add_functions (void) make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77); + add_sym_1 ("chdir", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_chdir, NULL, gfc_resolve_chdir, + a, BT_CHARACTER, dc, REQUIRED); + + make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU); + add_sym_3 ("cmplx", 1, 1, BT_COMPLEX, dz, GFC_STD_F77, gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx, x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL, @@ -1323,6 +1329,12 @@ add_functions (void) make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU); + add_sym_1 ("hostnm", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_hostnm, NULL, gfc_resolve_hostnm, + a, BT_CHARACTER, dc, REQUIRED); + + make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU); + add_sym_1 ("huge", 0, 1, BT_REAL, dr, GFC_STD_F95, gfc_check_huge, gfc_simplify_huge, NULL, x, BT_UNKNOWN, dr, REQUIRED); @@ -1383,6 +1395,11 @@ add_functions (void) make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95); + add_sym_0 ("ierrno", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + NULL, NULL, gfc_resolve_ierrno); + + make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU); + add_sym_3 ("index", 1, 1, BT_INTEGER, di, GFC_STD_F77, gfc_check_index, gfc_simplify_index, NULL, stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED, @@ -1430,6 +1447,12 @@ add_functions (void) make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95); + add_sym_2 ("kill", 1, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_kill, NULL, gfc_resolve_kill, + a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED); + + make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU); + add_sym_1 ("kind", 0, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_kind, gfc_simplify_kind, NULL, x, BT_REAL, dr, REQUIRED); @@ -1452,6 +1475,8 @@ add_functions (void) NULL, gfc_simplify_len_trim, gfc_resolve_len_trim, stg, BT_CHARACTER, dc, REQUIRED); + make_alias ("lnblnk", GFC_STD_GNU); + make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95); add_sym_2 ("lge", 1, 0, BT_LOGICAL, dl, GFC_STD_F77, @@ -1478,6 +1503,12 @@ add_functions (void) make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77); + add_sym_2 ("link", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_link, NULL, gfc_resolve_link, + a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED); + + make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU); + add_sym_1 ("log", 1, 1, BT_REAL, dr, GFC_STD_F77, gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log, x, BT_REAL, dr, REQUIRED); @@ -1744,6 +1775,12 @@ add_functions (void) make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77); + add_sym_2 ("rename", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_rename, NULL, gfc_resolve_rename, + a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED); + + make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU); + add_sym_2 ("repeat", 0, 1, BT_CHARACTER, dc, GFC_STD_F95, gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat, stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED); @@ -1904,6 +1941,12 @@ add_functions (void) make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95); + add_sym_2 ("symlnk", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_symlnk, NULL, gfc_resolve_symlnk, + a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED); + + make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU); + add_sym_1 ("system", 1, 1, BT_INTEGER, di, GFC_STD_GNU, NULL, NULL, NULL, c, BT_CHARACTER, dc, REQUIRED); @@ -1930,6 +1973,16 @@ add_functions (void) make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77); + add_sym_0 ("time", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + NULL, NULL, gfc_resolve_time); + + make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU); + + add_sym_0 ("time8", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + NULL, NULL, gfc_resolve_time8); + + make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU); + add_sym_1 ("tiny", 0, 1, BT_REAL, dr, GFC_STD_F95, gfc_check_x, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED); @@ -2024,6 +2077,10 @@ add_subroutines (void) gfc_check_second_sub, NULL, gfc_resolve_second_sub, tm, BT_REAL, dr, REQUIRED); + add_sym_2s ("chdir", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub, + name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_4s ("date_and_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL, dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL, @@ -2038,6 +2095,10 @@ add_subroutines (void) gfc_check_etime_sub, NULL, gfc_resolve_etime_sub, vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED); + add_sym_1s ("gerror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER, + dc, REQUIRED); + add_sym_2s ("getcwd", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub, c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); @@ -2050,6 +2111,10 @@ add_subroutines (void) NULL, NULL, gfc_resolve_getarg, c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED); + add_sym_1s ("getlog", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER, + dc, REQUIRED); + /* F2003 commandline routines. */ add_sym_3s ("get_command", 0, 1, BT_UNKNOWN, 0, GFC_STD_F2003, @@ -2098,6 +2163,32 @@ add_subroutines (void) gfc_check_flush, NULL, gfc_resolve_flush, c, BT_INTEGER, di, OPTIONAL); + add_sym_2s ("hostnm", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub, + c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + + add_sym_3s ("kill", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub, + NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED, + val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + + add_sym_3s ("link", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_link_sub, NULL, gfc_resolve_link_sub, + name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, + dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + + add_sym_1s ("perror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_perror, NULL, gfc_resolve_perror, + c, BT_CHARACTER, dc, REQUIRED); + + add_sym_3s ("rename", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_rename_sub, NULL, gfc_resolve_rename_sub, + name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, + dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + + add_sym_1s ("sleep", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub, + val, BT_CHARACTER, dc, REQUIRED); + add_sym_3s ("fstat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub, ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED, @@ -2108,6 +2199,11 @@ add_subroutines (void) name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("symlnk", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub, + name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, + dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_2s ("system", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub, c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 3f5fcba3736..bf2c80a0c7e 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -40,6 +40,7 @@ try gfc_check_atan2 (gfc_expr *, gfc_expr *); try gfc_check_besn (gfc_expr *, gfc_expr *); try gfc_check_btest (gfc_expr *, gfc_expr *); try gfc_check_char (gfc_expr *, gfc_expr *); +try gfc_check_chdir (gfc_expr *); try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_count (gfc_expr *, gfc_expr *); try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); @@ -55,6 +56,7 @@ try gfc_check_fn_r (gfc_expr *); try gfc_check_fn_rc (gfc_expr *); try gfc_check_fnum (gfc_expr *); try gfc_check_g77_math1 (gfc_expr *); +try gfc_check_hostnm (gfc_expr *); try gfc_check_huge (gfc_expr *); try gfc_check_i (gfc_expr *); try gfc_check_iand (gfc_expr *, gfc_expr *); @@ -69,8 +71,10 @@ try gfc_check_ior (gfc_expr *, gfc_expr *); try gfc_check_irand (gfc_expr *); try gfc_check_ishft (gfc_expr *, gfc_expr *); try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_kill (gfc_expr *, gfc_expr *); try gfc_check_kind (gfc_expr *); try gfc_check_lbound (gfc_expr *, gfc_expr *); +try gfc_check_link (gfc_expr *, gfc_expr *); try gfc_check_logical (gfc_expr *, gfc_expr *); try gfc_check_min_max (gfc_actual_arglist *); try gfc_check_min_max_integer (gfc_actual_arglist *); @@ -90,6 +94,7 @@ try gfc_check_radix (gfc_expr *); try gfc_check_rand (gfc_expr *); try gfc_check_range (gfc_expr *); try gfc_check_real (gfc_expr *, gfc_expr *); +try gfc_check_rename (gfc_expr *, gfc_expr *); try gfc_check_repeat (gfc_expr *, gfc_expr *); try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_scale (gfc_expr *, gfc_expr *); @@ -105,6 +110,7 @@ try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_srand (gfc_expr *); try gfc_check_stat (gfc_expr *, gfc_expr *); try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_symlnk (gfc_expr *, gfc_expr *); try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_transpose (gfc_expr *); try gfc_check_trim (gfc_expr *); @@ -117,18 +123,28 @@ try gfc_check_x (gfc_expr *); /* Intrinsic subroutines. */ +try gfc_check_chdir_sub (gfc_expr *, gfc_expr *); try gfc_check_cpu_time (gfc_expr *); try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_exit (gfc_expr *); try gfc_check_flush (gfc_expr *); try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_gerror (gfc_expr *); +try gfc_check_getlog (gfc_expr *); try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_random_number (gfc_expr *); try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_etime_sub (gfc_expr *, gfc_expr *); try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); +try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); +try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_perror (gfc_expr *); +try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_sleep_sub (gfc_expr *); try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_system_sub (gfc_expr *, gfc_expr *); try gfc_check_umask_sub (gfc_expr *, gfc_expr *); @@ -256,6 +272,7 @@ void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_chdir (gfc_expr *, gfc_expr *); void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_conjg (gfc_expr *, gfc_expr *); @@ -281,10 +298,12 @@ void gfc_resolve_getcwd (gfc_expr *, gfc_expr *); void gfc_resolve_getgid (gfc_expr *); void gfc_resolve_getpid (gfc_expr *); void gfc_resolve_getuid (gfc_expr *); +void gfc_resolve_hostnm (gfc_expr *, gfc_expr *); void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_ierrno (gfc_expr *); void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ichar (gfc_expr *, gfc_expr *); void gfc_resolve_idnint (gfc_expr *, gfc_expr *); @@ -292,9 +311,11 @@ void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_len (gfc_expr *, gfc_expr *); void gfc_resolve_len_trim (gfc_expr *, gfc_expr *); +void gfc_resolve_link (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_log (gfc_expr *, gfc_expr *); void gfc_resolve_log10 (gfc_expr *, gfc_expr *); void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *); @@ -314,6 +335,7 @@ void gfc_resolve_not (gfc_expr *, gfc_expr *); void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_product (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_real (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_rename (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_repeat (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); @@ -332,9 +354,12 @@ void gfc_resolve_sqrt (gfc_expr *, gfc_expr *); void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_srand (gfc_code *); void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_system (gfc_expr *, gfc_expr *); void gfc_resolve_tan (gfc_expr *, gfc_expr *); void gfc_resolve_tanh (gfc_expr *, gfc_expr *); +void gfc_resolve_time (gfc_expr *); +void gfc_resolve_time8 (gfc_expr *); void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_transpose (gfc_expr *, gfc_expr *); void gfc_resolve_trim (gfc_expr *, gfc_expr *); @@ -346,17 +371,27 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); /* Intrinsic subroutine resolution. */ +void gfc_resolve_chdir_sub (gfc_code *); void gfc_resolve_cpu_time (gfc_code *); void gfc_resolve_exit (gfc_code *); void gfc_resolve_flush (gfc_code *); void gfc_resolve_fstat_sub (gfc_code *); +void gfc_resolve_gerror (gfc_code *); void gfc_resolve_getarg (gfc_code *); void gfc_resolve_getcwd_sub (gfc_code *); +void gfc_resolve_getlog (gfc_code *); void gfc_resolve_get_command (gfc_code *); void gfc_resolve_get_command_argument (gfc_code *); void gfc_resolve_get_environment_variable (gfc_code *); +void gfc_resolve_hostnm_sub (gfc_code *); +void gfc_resolve_kill_sub (gfc_code *); void gfc_resolve_mvbits (gfc_code *); +void gfc_resolve_perror (gfc_code *); void gfc_resolve_random_number (gfc_code *); +void gfc_resolve_rename_sub (gfc_code *); +void gfc_resolve_link_sub (gfc_code *); +void gfc_resolve_symlnk_sub (gfc_code *); +void gfc_resolve_sleep_sub (gfc_code *); void gfc_resolve_stat_sub (gfc_code *); void gfc_resolve_system_clock (gfc_code *); void gfc_resolve_system_sub (gfc_code *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi new file mode 100644 index 00000000000..2f13838f1d6 --- /dev/null +++ b/gcc/fortran/intrinsic.texi @@ -0,0 +1,1904 @@ +@ignore +Copyright (C) 2005 +Free Software Foundation, Inc. +This is part of the GFORTRAN manual. +For copying conditions, see the file gfortran.texi. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with the +Invariant Sections being ``GNU General Public License'' and ``Funding +Free Software'', the Front-Cover texts being (a) (see below), and with +the Back-Cover Texts being (b) (see below). A copy of the license is +included in the gfdl(7) man page. + + +Some basic guidelines for editing this document: + + (1) The intrinsic procedures are to be listed in alphabetical order. + (2) The generic name is to be use. + (3) The specific names are included in the function index and in a + table at the end of the node (See ABS entry). + (4) Try to maintain the same style for each entry. + + +@end ignore + +@node Intrinsic Procedures +@chapter Intrinsic Procedures +@cindex Intrinsic Procedures + +This portion of the document is incomplete and undergoing massive expansion +and editing. All contributions and corrections are strongly encouraged. + +@menu +* Introduction: Introduction +* @code{ABORT}: ABORT, Abort the program +* @code{ABS}: ABS, Absolute value +* @code{ACHAR}: ACHAR, Character in @acronym{ASCII} collating sequence +* @code{ACOS}: ACOS, Arccosine function +* @code{ADJUSTL}: ADJUSTL, Left adjust a string +* @code{ADJUSTR}: ADJUSTR, Right adjust a string +* @code{AIMAG}: AIMAG, Imaginary part of complex number +* @code{AINT}: AINT, Truncate to a whole number +* @code{ALL}: ALL, Determine if all values are true +* @code{ALLOCATED}: ALLOCATED, Status of allocatable entity +* @code{ANINT}: ANINT, Nearest whole number +* @code{ANY}: ANY, Determine if any values are true +* @code{ASIN}: ASIN, Arcsine function +* @code{ATAN}: ATAN, Arctangent function +* @code{BESJ0}: BESJ0, Bessel function of the first kind of order 0 +* @code{BESJ1}: BESJ1, Bessel function of the first kind of order 1 +* @code{BESJN}: BESJN, Bessel function of the first kind +* @code{BESY0}: BESY0, Bessel function of the second kind of order 0 +* @code{BESY1}: BESY1, Bessel function of the second kind of order 1 +* @code{BESYN}: BESYN, Bessel function of the second kind +* @code{COS}: COS, Cosine function +* @code{COSH}: COSH, Hyperbolic cosine function +* @code{ERF}: ERF, Error function +* @code{ERFC}: ERFC, Complementary error function +* @code{EXP}: EXP, Cosine function +* @code{LOG}: LOG, Logarithm function +* @code{LOG10}: LOG10, Base 10 logarithm function +* @code{SQRT}: SQRT, Square-root function +* @code{SIN}: SIN, Sine function +* @code{SINH}: SINH, Hyperbolic sine function +* @code{TAN}: TAN, Tangent function +* @code{TANH}: TANH, Hyperbolic tangent function +@end menu + +@node Introduction +@section Introduction to intrinsic procedures + +Gfortran provides a rich set of intrinsic procedures that includes all +the intrinsic procedures required by the Fortran 95 standard, a set of +intrinsic procedures for backwards compatibility with Gnu Fortran 77 +(i.e., @command{g77}), and a small selection of intrinsic procedures +from the Fortran 2003 standard. Any description here, which conflicts with a +description in either the Fortran 95 standard or the Fortran 2003 standard, +is unintentional and the standard(s) should be considered authoritative. + +The enumeration of the @code{KIND} type parameter is processor defined in +the Fortran 95 standard. Gfortran defines the default integer type and +default real type by @code{INTEGER(KIND=4)} and @code{REAL(KIND=4)}, +respectively. The standard mandates that both data types shall have +another kind, which have more precision. On typical target architectures +supports by @command{gfortran}, this kind type parameter is @code{KIND=8}. +Hence, @code{REAL(KIND=8)} and @code{DOUBLE PRECISION} are equivalent. +In the description of generic intrinsic procedures, the kind type parameter +will be specified by @code{KIND=*}, and in the description of specific +names for an intrinsic procedure the kind type parameter will be explicitly +given (e.g., @code{REAL(KIND=4)} or @code{REAL(KIND=8)}). Finally, for +brevity the optional @code{KIND=} syntax will be omitted. + +Many of the intrinsics procedures take one or more optional arguments. +This document follows the convention used in the Fortran 95 standard, +and denotes such arguments by square brackets. + +@command{Gfortran} offers the @option{-std=f95} and @option{-std=gnu} options, +which can be used to restrict the set of intrinsic procedures to a +given standard. By default, @command{gfortran} sets the @option{-std=gnu} +option, and so all intrinsic procedures describe here are accepted. There +is one caveat. For a select group of intrinsic procedures, @command{g77} +implemented both a function and a subroutine. Both classes +have been implemented in @command{gfortran} for backwards compatibility +with @command{g77}. It is noted here that these functions and subroutines +cannot be intermixed in a given subprogram. In the descriptions that follow, +the applicable option(s) is noted. + + + +@node ABORT +@section @code{ABORT} --- Abort the program +@findex @code{ABORT} +@cindex abort + +@table @asis +@item @emph{Description}: +@code{ABORT} causes immediate termination of the program. On operating +systems that support a core dump, @code{ABORT} will produce a core dump, +which is suitable for debugging purposes. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +non-elemental subroutine + +@item @emph{Syntax}: +@code{CALL ABORT} + +@item @emph{Return value}: +Does not return. + +@item @emph{Example}: +@smallexample +program test_abort + integer :: i = 1, j = 2 + if (i /= j) call abort +end program test_abort +@end smallexample +@end table + + + +@node ABS +@section @code{ABS} --- Absolute value +@findex @code{ABS} intrinsic +@findex @code{CABS} intrinsic +@findex @code{DABS} intrinsic +@findex @code{IABS} intrinsic +@findex @code{ZABS} intrinsic +@findex @code{CDABS} intrinsic +@cindex absolute value + +@table @asis +@item @emph{Description}: +@code{ABS(X)} computes the absolute value of @code{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ABS(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type of the argument shall be an @code{INTEGER(*)}, +@code{REAL(*)}, or @code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of the same type and +kind as the argument except the return value is @code{REAL(*)} for a +@code{COMPLEX(*)} argument. + +@item @emph{Example}: +@smallexample +program test_abs + integer :: i = -1 + real :: x = -1.e0 + complex :: z = (-1.e0,0.e0) + i = abs(i) + x = abs(x) + x = abs(z) +end program test_abs +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{CABS(Z)} @tab @code{COMPLEX(4) Z} @tab @code{REAL(4)} @tab f95, gnu +@item @code{DABS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{IABS(I)} @tab @code{INTEGER(4) I} @tab @code{INTEGER(4)} @tab f95, gnu +@item @code{ZABS(Z)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab gnu +@item @code{CDABS(Z)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab gnu +@end multitable +@end table + + + +@node ACHAR +@section @code{ACHAR} --- Character in @acronym{ASCII} collating sequence +@findex @code{ACHAR} intrinsic +@cindex @acronym{ASCII} collating sequence + +@table @asis +@item @emph{Description}: +@code{ACHAR(I)} returns the character located at position @code{I} +in the @acronym{ASCII} collating sequence. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{C = ACHAR(I)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{I} @tab The type shall be an @code{INTEGER(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{CHARACTER} with a length of one. The +kind type parameter is the same as @code{KIND('A')}. + +@item @emph{Example}: +@smallexample +program test_achar + character c + c = achar(32) +end program test_achar +@end smallexample +@end table + + + +@node ACOS +@section @code{ACOS} --- Arccosine function +@findex @code{ACOS} intrinsic +@findex @code{DACOS} intrinsic +@cindex arccosine + +@table @asis +@item @emph{Description}: +@code{ACOS(X)} computes the arccosine of its @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ACOS(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}, and a magnitude that is +less than one. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it lies in the +range @math{ 0 \leq \arccos (x) \leq \pi}. The kind type +parameter is the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_acos + real(8) :: x = 0.866_8 + x = achar(x) +end program test_acos +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + + +@node ADJUSTL +@section @code{ADJUSTL} --- Left adjust a string +@findex @code{ADJUSTL} intrinsic +@cindex adjust string + +@table @asis +@item @emph{Description}: +@code{ADJUSTL(STR)} will left adjust a string by removing leading spaces. +Spaces are inserted at the end of the string as needed. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{STR = ADJUSTL(STR)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{STR} @tab The type shall be @code{CHARACTER}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{CHARACTER} where leading spaces +are removed and the same number of spaces are inserted on the end +of @var{STR}. + +@item @emph{Example}: +@smallexample +program test_adjustl + character(len=20) :: str = ' gfortran' + str = adjustl(str) + print *, str +end program test_adjustl +@end smallexample +@end table + + +@node ADJUSTR +@section @code{ADJUSTR} --- Right adjust a string +@findex @code{ADJUSTR} intrinsic +@cindex adjust string + +@table @asis +@item @emph{Description}: +@code{ADJUSTR(STR)} will right adjust a string by removing trailing spaces. +Spaces are inserted at the start of the string as needed. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{STR = ADJUSTR(STR)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{STR} @tab The type shall be @code{CHARACTER}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{CHARACTER} where trailing spaces +are removed and the same number of spaces are inserted at the start +of @var{STR}. + +@item @emph{Example}: +@smallexample +program test_adjustr + character(len=20) :: str = 'gfortran' + str = adjustr(str) + print *, str +end program test_adjustr +@end smallexample +@end table + + +@node AIMAG +@section @code{AIMAG} --- Imaginary part of complex number +@findex @code{AIMAG} intrinsic +@findex @code{DIMAG} intrinsic +@cindex Imaginary part + +@table @asis +@item @emph{Description}: +@code{AIMAG(Z)} yields the imaginary part of complex argument @code{Z}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = AIMAG(Z)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{Z} @tab The type of the argument shall be @code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type real with the +kind type parameter of the argument. + +@item @emph{Example}: +@smallexample +program test_aimag + complex(4) z4 + complex(8) z8 + z4 = cmplx(1.e0_4, 0.e0_4) + z8 = cmplx(0.e0_8, 1.e0_8) + print *, aimag(z4), dimag(z8) +end program test_aimag +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node AINT +@section @code{AINT} --- Imaginary part of complex number +@findex @code{AINT} intrinsic +@findex @code{DINT} intrinsic +@cindex whole number + +@table @asis +@item @emph{Description}: +@code{AINT(X [, KIND])} truncates its argument to a whole number. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = AINT(X)} @* +@code{X = AINT(X, KIND)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type of the argument shall be @code{REAL(*)}. +@item @var{KIND} @tab (Optional) @var{KIND} shall be a scalar integer +initialization expression. +@end multitable + +@item @emph{Return value}: +The return value is of type real with the kind type parameter of the +argument if the optional @var{KIND} is absence; otherwise, the kind +type parameter will be given by @var{KIND}. If the magnitude of +@var{X} is less than one, then @code{AINT(X)} returns zero. If the +magnitude is equal to or greater than one, then it returns the largest +whole number that does not exceed its magnitude. The sign is the same +as the sign of @var{X}. + +@item @emph{Example}: +@smallexample +program test_aint + real(4) x4 + real(8) x8 + x4 = 1.234E0_4 + x8 = 4.321_8 + print *, aint(x4), dint(x8) + x8 = aint(x4,8) +end program test_aint +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DINT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node ALL +@section @code{ALL} --- All values in @var{MASK} along @var{DIM} are true + @findex @code{ALL} intrinsic +@cindex true values + +@table @asis +@item @emph{Description}: +@code{ALL(MASK [, DIM])} determines if all the values are true in @var{MASK} +in the array along dimension @var{DIM}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +transformational function + +@item @emph{Syntax}: +@code{L = ALL(MASK)} @* +@code{L = ALL(MASK, DIM)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{MASK} @tab The type of the argument shall be @code{LOGICAL(*)} and +it shall not be scalar. +@item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer +with a value that lies between one and the rank of @var{MASK}. +@end multitable + +@item @emph{Return value}: +@code{ALL(MASK)} returns a scalar value of type @code{LOGICAL(*)} where +the kind type parameter is the same as the kind type parameter of +@var{MASK}. If @var{DIM} is present, then @code{ALL(MASK, DIM)} returns +an array with the rank of @var{MASK} minus 1. The shape is determined from +the shape of @var{MASK} where the @var{DIM} dimension is elided. + +@table @asis +@item (A) +@code{ALL(MASK)} is true if all elements of @var{MASK} are true. +It also is true if @var{MASK} has zero size; otherwise, it is false. +@item (B) +If the rank of @var{MASK} is one, then @code{ALL(MASK,DIM)} is equivalent +to @code{ALL(MASK)}. If the rank is greater than one, then @code{ALL(MASK,DIM)} +is determined by applying @code{ALL} to the array sections. +@end table + +@item @emph{Example}: +@smallexample +program test_all + logical l + l = all((/.true., .true., .true./)) + print *, l + call section + contains + subroutine section + integer a(2,3), b(2,3) + a = 1 + b = 1 + b(2,2) = 2 + print *, all(a .eq. b, 1) + print *, all(a .eq. b, 2) + end subroutine section +end program test_all +@end smallexample +@end table + + +@node ALLOCATED +@section @code{ALLOCATED} --- Status of an allocatable entity +@findex @code{ALLOCATED} intrinsic +@cindex allocation status + +@table @asis +@item @emph{Description}: +@code{ALLOCATED(X)} checks the status of wether @var{X} is allocated. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +inquiry function + +@item @emph{Syntax}: +@code{L = ALLOCATED(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The argument shall be an @code{ALLOCATABLE} array. +@end multitable + +@item @emph{Return value}: +The return value is a scalar @code{LOGICAL} with the default logical +kind type parameter. If @var{X} is allocated, @code{ALLOCATED(X)} +is @code{.TRUE.}; otherwise, it returns the @code{.TRUE.} + +@item @emph{Example}: +@smallexample +program test_allocated + integer :: i = 4 + real(4), allocatable :: x(:) + if (allocated(x) .eqv. .false.) allocate(x(i) +end program test_allocated +@end smallexample +@end table + + +@node ANINT +@section @code{ANINT} --- Imaginary part of complex number +@findex @code{ANINT} intrinsic +@findex @code{DNINT} intrinsic +@cindex whole number + +@table @asis +@item @emph{Description}: +@code{ANINT(X [, KIND])} rounds its argument to the nearest whole number. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ANINT(X)} @* +@code{X = ANINT(X, KIND)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type of the argument shall be @code{REAL(*)}. +@item @var{KIND} @tab (Optional) @var{KIND} shall be a scalar integer +initialization expression. +@end multitable + +@item @emph{Return value}: +The return value is of type real with the kind type parameter of the +argument if the optional @var{KIND} is absence; otherwise, the kind +type parameter will be given by @var{KIND}. If @var{X} is greater than +zero, then @code{ANINT(X)} returns @code{AINT(X+0.5)}. If @var{X} is +less than or equal to zero, then return @code{AINT(X-0.5)}. + +@item @emph{Example}: +@smallexample +program test_anint + real(4) x4 + real(8) x8 + x4 = 1.234E0_4 + x8 = 4.321_8 + print *, anint(x4), dnint(x8) + x8 = anint(x4,8) +end program test_anint +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DNINT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node ANY +@section @code{ANY} --- Any value in @var{MASK} along @var{DIM} is true + @findex @code{ANY} intrinsic +@cindex true values + +@table @asis +@item @emph{Description}: +@code{ANY(MASK [, DIM])} determines if any of the values is true in @var{MASK} +in the array along dimension @var{DIM}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +transformational function + +@item @emph{Syntax}: +@code{L = ANY(MASK)} @* +@code{L = ANY(MASK, DIM)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{MASK} @tab The type of the argument shall be @code{LOGICAL(*)} and +it shall not be scalar. +@item @var{DIM} @tab (Optional) @var{DIM} shall be a scalar integer +with a value that lies between one and the rank of @var{MASK}. +@end multitable + +@item @emph{Return value}: +@code{ANY(MASK)} returns a scalar value of type @code{LOGICAL(*)} where +the kind type parameter is the same as the kind type parameter of +@var{MASK}. If @var{DIM} is present, then @code{ANY(MASK, DIM)} returns +an array with the rank of @var{MASK} minus 1. The shape is determined from +the shape of @var{MASK} where the @var{DIM} dimension is elided. + +@table @asis +@item (A) +@code{ANY(MASK)} is true if any element of @var{MASK} is true; +otherwise, it is false. It also is false if @var{MASK} has zero size. +@item (B) +If the rank of @var{MASK} is one, then @code{ANY(MASK,DIM)} is equivalent +to @code{ANY(MASK)}. If the rank is greater than one, then @code{ANY(MASK,DIM)} +is determined by applying @code{ANY} to the array sections. +@end table + +@item @emph{Example}: +@smallexample +program test_any + logical l + l = any((/.true., .true., .true./)) + print *, l + call section + contains + subroutine section + integer a(2,3), b(2,3) + a = 1 + b = 1 + b(2,2) = 2 + print *, any(a .eq. b, 1) + print *, any(a .eq. b, 2) + end subroutine section +end program test_any +@end smallexample +@end table + + +@node ASIN +@section @code{ASIN} --- Arcsine function +@findex @code{ASIN} intrinsic +@findex @code{DASIN} intrinsic +@cindex arcsine + +@table @asis +@item @emph{Description}: +@code{ASIN(X)} computes the arcsine of its @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ASIN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}, and a magnitude that is +less than one. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it lies in the +range @math{ \pi / 2 \leq \arccos (x) \leq \pi / 2}. The kind type +parameter is the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_asin + real(8) :: x = 0.866_8 + x = asin(x) +end program test_asin +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DASIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node ATAN +@section @code{ATAN} --- Arctangent function +@findex @code{ATAN} intrinsic +@findex @code{DATAN} intrinsic +@cindex arctangent + +@table @asis +@item @emph{Description}: +@code{ATAN(X)} computes the arctangent of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ATAN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it lies in the +range @math{ - \pi / 2 \leq \arcsin (x) \leq \pi / 2}. + +@item @emph{Example}: +@smallexample +program test_atan + real(8) :: x = 2.866_8 + x = atan(x) +end program test_atan +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DATAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + + +@node BESJ0 +@section @code{BESJ0} --- Bessel function of the first kind of order 0 +@findex @code{BESJ0} intrinsic +@findex @code{DBESJ0} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESJ0(X)} computes the Bessel function of the first kind of order 0 +of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = BESJ0(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it lies in the +range @math{ - 0.4027... \leq Bessel (0,x) \leq 1}. + +@item @emph{Example}: +@smallexample +program test_besj0 + real(8) :: x = 0.0_8 + x = besj0(x) +end program test_besj0 +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESJ0(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node BESJ1 +@section @code{BESJ1} --- Bessel function of the first kind of order 1 +@findex @code{BESJ1} intrinsic +@findex @code{DBESJ1} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESJ1(X)} computes the Bessel function of the first kind of order 1 +of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = BESJ1(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it lies in the +range @math{ - 0.5818... \leq Bessel (0,x) \leq 0.5818 }. + +@item @emph{Example}: +@smallexample +program test_besj1 + real(8) :: x = 1.0_8 + x = besj1(x) +end program test_besj1 +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESJ1(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node BESJN +@section @code{BESJN} --- Bessel function of the first kind +@findex @code{BESJN} intrinsic +@findex @code{DBESJN} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESJN(N, X)} computes the Bessel function of the first kind of order +@var{N} of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{Y = BESJN(N, X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{N} @tab The type shall be an @code{INTEGER(*)}. +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. + +@item @emph{Example}: +@smallexample +program test_besjn + real(8) :: x = 1.0_8 + x = besjn(5,x) +end program test_besjn +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESJN(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node BESY0 +@section @code{BESY0} --- Bessel function of the second kind of order 0 +@findex @code{BESY0} intrinsic +@findex @code{DBESY0} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESY0(X)} computes the Bessel function of the second kind of order 0 +of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = BESY0(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. + +@item @emph{Example}: +@smallexample +program test_besy0 + real(8) :: x = 0.0_8 + x = besy0(x) +end program test_besy0 +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESY0(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node BESY1 +@section @code{BESY1} --- Bessel function of the second kind of order 1 +@findex @code{BESY1} intrinsic +@findex @code{DBESY1} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESY1(X)} computes the Bessel function of the second kind of order 1 +of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = BESY1(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. + +@item @emph{Example}: +@smallexample +program test_besy1 + real(8) :: x = 1.0_8 + x = besy1(x) +end program test_besy1 +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESY1(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node BESYN +@section @code{BESYN} --- Bessel function of the second kind +@findex @code{BESYN} intrinsic +@findex @code{DBESYN} intrinsic +@cindex Bessel + +@table @asis +@item @emph{Description}: +@code{BESYN(N, X)} computes the Bessel function of the second kind of order +@var{N} of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{Y = BESYN(N, X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{N} @tab The type shall be an @code{INTEGER(*)}. +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. + +@item @emph{Example}: +@smallexample +program test_besyn + real(8) :: x = 1.0_8 + x = besyn(5,x) +end program test_besyn +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DBESYN(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + +@node COS +@section @code{COS} --- Cosine function +@findex @code{COS} intrinsic +@findex @code{DCOS} intrinsic +@findex @code{ZCOS} intrinsic +@findex @code{CDCOS} intrinsic +@cindex cosine + +@table @asis +@item @emph{Description}: +@code{COS(X)} computes the cosine of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = COS(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind than @var{X}. + +@item @emph{Example}: +@smallexample +program test_cos + real :: x = 0.0 + x = cos(x) +end program test_cos +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DCOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{CCOS(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab f95, gnu +@item @code{ZCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@item @code{CDCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@end multitable +@end table + + +@node COSH +@section @code{COSH} --- Hyperbolic cosine function +@findex @code{COSH} intrinsic +@findex @code{DCOSH} intrinsic +@cindex hyperbolic cosine + +@table @asis +@item @emph{Description}: +@code{COSH(X)} computes the hyperbolic cosine of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = COSH(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it is positive +(@math{ \cosh (x) \geq 0 }. + +@item @emph{Example}: +@smallexample +program test_cosh + real(8) :: x = 1.0_8 + x = cosh(x) +end program test_cosh +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DCOSH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node ERF +@section @code{ERF} --- Error function +@findex @code{ERF} intrinsic +@cindex error + +@table @asis +@item @emph{Description}: +@code{ERF(X)} computes the error function of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ERF(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it is positive +(@math{ - 1 \leq erf (x) \leq 1 }. + +@item @emph{Example}: +@smallexample +program test_erf + real(8) :: x = 0.17_8 + x = erf(x) +end program test_erf +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DERF(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node ERFC +@section @code{ERFC} --- Error function +@findex @code{ERFC} intrinsic +@cindex error + +@table @asis +@item @emph{Description}: +@code{ERFC(X)} computes the complementary error function of @var{X}. + +@item @emph{Option}: +gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = ERFC(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and it is positive +(@math{ 0 \leq erfc (x) \leq 2 }. + +@item @emph{Example}: +@smallexample +program test_erfc + real(8) :: x = 0.17_8 + x = erfc(x) +end program test_erfc +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DERFC(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab gnu +@end multitable +@end table + + + +@node EXP +@section @code{EXP} --- Exponential function +@findex @code{EXP} intrinsic +@findex @code{DEXP} intrinsic +@findex @code{ZEXP} intrinsic +@findex @code{CDEXP} intrinsic +@cindex exponential + +@table @asis +@item @emph{Description}: +@code{EXP(X)} computes the base @math{e} exponential of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = EXP(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind than @var{X}. + +@item @emph{Example}: +@smallexample +program test_exp + real :: x = 1.0 + x = exp(x) +end program test_exp +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DEXP(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{CEXP(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab f95, gnu +@item @code{ZEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@item @code{CDEXP(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@end multitable +@end table + + +@node LOG +@section @code{LOG} --- Logarithm function +@findex @code{LOG} intrinsic +@findex @code{ALOG} intrinsic +@findex @code{DLOG} intrinsic +@findex @code{CLOG} intrinsic +@findex @code{ZLOG} intrinsic +@findex @code{CDLOG} intrinsic +@cindex logarithm + +@table @asis +@item @emph{Description}: +@code{LOG(X)} computes the logarithm of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = LOG(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} or @code{COMPLEX(*)}. +The kind type parameter is the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_log + real(8) :: x = 1.0_8 + complex :: z = (1.0, 2.0) + x = log(x) + z = log(z) +end program test_log +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{ALOG(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab f95, gnu +@item @code{DLOG(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{CLOG(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab f95, gnu +@item @code{ZLOG(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@item @code{CDLOG(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@end multitable +@end table + + + +@node LOG10 +@section @code{LOG10} --- Base 10 logarithm function +@findex @code{LOG10} intrinsic +@findex @code{ALOG10} intrinsic +@findex @code{DLOG10} intrinsic +@cindex logarithm + +@table @asis +@item @emph{Description}: +@code{LOG10(X)} computes the base 10 logarithm of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = LOG10(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} or @code{COMPLEX(*)}. +The kind type parameter is the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_log10 + real(8) :: x = 10.0_8 + x = log10(x) +end program test_log10 +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{ALOG10(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab f95, gnu +@item @code{DLOG10(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + + +@node SIN +@section @code{SIN} --- Sine function +@findex @code{SIN} intrinsic +@findex @code{DSIN} intrinsic +@findex @code{ZSIN} intrinsic +@findex @code{CDSIN} intrinsic +@cindex sine + +@table @asis +@item @emph{Description}: +@code{SIN(X)} computes the sine of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = SIN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value has same type and king than @var{X}. + +@item @emph{Example}: +@smallexample +program test_sin + real :: x = 0.0 + x = sin(x) +end program test_sin +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DSIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{CSIN(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab f95, gnu +@item @code{ZSIN(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@item @code{CDSIN(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@end multitable +@end table + + + + +@node SINH +@section @code{SINH} --- Hyperbolic sine function +@findex @code{SINH} intrinsic +@findex @code{DSINH} intrinsic +@cindex hyperbolic sine + +@table @asis +@item @emph{Description}: +@code{SINH(X)} computes the hyperbolic sine of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = SINH(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. + +@item @emph{Example}: +@smallexample +program test_sinh + real(8) :: x = - 1.0_8 + x = sinh(x) +end program test_sinh +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DSINH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + + +@node SQRT +@section @code{SQRT} --- Square-root function +@findex @code{SQRT} intrinsic +@findex @code{DSQRT} intrinsic +@findex @code{CSQRT} intrinsic +@findex @code{ZSQRT} intrinsic +@findex @code{CDSQRT} intrinsic +@cindex square-root + +@table @asis +@item @emph{Description}: +@code{SQRT(X)} computes the square root of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = SQRT(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)} or +@code{COMPLEX(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} or @code{COMPLEX(*)}. +The kind type parameter is the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_sqrt + real(8) :: x = 2.0_8 + complex :: z = (1.0, 2.0) + x = sqrt(x) + z = sqrt(z) +end program test_sqrt +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DSQRT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@item @code{CSQRT(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab f95, gnu +@item @code{ZSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@item @code{CDSQRT(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab f95, gnu +@end multitable +@end table + + + +@node TAN +@section @code{TAN} --- Tangent function +@findex @code{TAN} intrinsic +@findex @code{DTAN} intrinsic +@cindex tangent + +@table @asis +@item @emph{Description}: +@code{TAN(X)} computes the tangent of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = TAN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)}. The kind type parameter is +the same as @var{X}. + +@item @emph{Example}: +@smallexample +program test_tan + real(8) :: x = 0.165_8 + x = tan(x) +end program test_tan +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + +@node TANH +@section @code{TANH} --- Hyperbolic tangent function +@findex @code{TANH} intrinsic +@findex @code{DTANH} intrinsic +@cindex hyperbolic tangent + +@table @asis +@item @emph{Description}: +@code{TANH(X)} computes the hyperbolic tangent of @var{X}. + +@item @emph{Option}: +f95, gnu + +@item @emph{Type}: +elemental function + +@item @emph{Syntax}: +@code{X = TANH(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .80 +@item @var{X} @tab The type shall be an @code{REAL(*)}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{REAL(*)} and lies in the range +@math{ - 1 \leq tanh(x) \leq 1 }. + +@item @emph{Example}: +@smallexample +program test_tanh + real(8) :: x = 2.1_8 + x = tanh(x) +end program test_tanh +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .24 .24 .24 .24 +@item Name @tab Argument @tab Return type @tab Option +@item @code{DTANH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab f95, gnu +@end multitable +@end table + + + +@comment gen associated +@comment +@comment gen atan2 +@comment datan2 +@comment +@comment gen bit_size +@comment +@comment gen btest +@comment +@comment gen ceiling +@comment +@comment gen char +@comment +@comment gen cmplx +@comment +@comment gen command_argument_count +@comment +@comment gen conjg +@comment dconjg +@comment +@comment gen count +@comment +@comment sub cpu_time +@comment +@comment gen cshift +@comment +@comment sub date_and_time +@comment +@comment gen dble +@comment dfloat +@comment +@comment gen dcmplx +@comment +@comment gen digits +@comment +@comment gen dim +@comment idim +@comment ddim +@comment +@comment gen dot_product +@comment +@comment gen dprod +@comment +@comment gen dreal +@comment +@comment sub dtime +@comment +@comment gen eoshift +@comment +@comment gen epsilon +@comment +@comment gen etime +@comment sub etime +@comment +@comment sub exit +@comment +@comment gen exponent +@comment +@comment gen floor +@comment +@comment sub flush +@comment +@comment gen fnum +@comment +@comment gen fraction +@comment +@comment gen fstat +@comment sub fstat +@comment +@comment sub getarg +@comment +@comment gen getcwd +@comment sub getcwd +@comment +@comment sub getenv +@comment +@comment gen getgid +@comment +@comment gen getpid +@comment +@comment gen getuid +@comment +@comment sub get_command +@comment +@comment sub get_command_argument +@comment +@comment sub get_environment_variable +@comment +@comment gen huge +@comment +@comment gen iachar +@comment +@comment gen iand +@comment +@comment gen iargc +@comment +@comment gen ibclr +@comment +@comment gen ibits +@comment +@comment gen ibset +@comment +@comment gen ichar +@comment +@comment gen ieor +@comment +@comment gen index +@comment +@comment gen int +@comment ifix +@comment idint +@comment +@comment gen ior +@comment +@comment gen irand +@comment +@comment gen ishft +@comment +@comment gen ishftc +@comment +@comment gen kind +@comment +@comment gen lbound +@comment +@comment gen len +@comment +@comment gen len_trim +@comment +@comment gen lge +@comment +@comment gen lgt +@comment +@comment gen lle +@comment +@comment gen llt +@comment +@comment gen logical +@comment +@comment gen matmul +@comment +@comment gen max +@comment max0 +@comment amax0 +@comment amax1 +@comment max1 +@comment dmax1 +@comment +@comment gen maxexponent +@comment +@comment gen maxloc +@comment +@comment gen maxval +@comment +@comment gen merge +@comment +@comment gen min +@comment min0 +@comment amin0 +@comment amin1 +@comment min1 +@comment dmin1 +@comment +@comment gen minexponent +@comment +@comment gen minloc +@comment +@comment gen minval +@comment +@comment gen mod +@comment amod +@comment dmod +@comment +@comment gen modulo +@comment +@comment sub mvbits +@comment +@comment gen nearest +@comment +@comment gen nint +@comment idnint +@comment +@comment gen not +@comment +@comment gen null +@comment +@comment gen pack +@comment +@comment gen precision +@comment +@comment gen present +@comment +@comment gen product +@comment +@comment gen radix +@comment +@comment gen rand +@comment ran +@comment +@comment sub random_number +@comment +@comment sub random_seed +@comment +@comment gen range +@comment +@comment gen real +@comment float +@comment sngl +@comment +@comment gen repeat +@comment +@comment gen reshape +@comment +@comment gen rrspacing +@comment +@comment gen scale +@comment +@comment gen scan +@comment +@comment gen second +@comment sub second +@comment +@comment gen selected_int_kind +@comment +@comment gen selected_real_kind +@comment +@comment gen set_exponent +@comment +@comment gen shape +@comment +@comment gen sign +@comment isign +@comment dsign +@comment +@comment gen size +@comment +@comment gen spacing +@comment +@comment gen spread +@comment +@comment sub srand +@comment +@comment gen stat +@comment sub stat +@comment +@comment gen sum +@comment +@comment gen system +@comment sub system +@comment +@comment sub system_clock +@comment +@comment gen tiny +@comment +@comment gen transfer +@comment +@comment gen transpose +@comment +@comment gen trim +@comment +@comment gen ubound +@comment +@comment gen umask +@comment sub umask +@comment +@comment gen unlink +@comment sub unlink +@comment +@comment gen unpack +@comment +@comment gen verify + diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 0d2f94d4f49..e5b93902a38 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -119,7 +119,7 @@ by type. Explanations are in the following sections. -fdollar-ok -fimplicit-none -fmax-identifier-length @gol -std=@var{std} -ffixed-line-length-@var{n} -ffixed-line-length-none @gol --i8 -r8 -d8} +-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 } @item Warning Options @xref{Warning Options,,Options to Request or Suppress Warnings}. @@ -183,6 +183,23 @@ Specify the layout used by the the source file. The free form layout was introduced in Fortran 90. Fixed form was traditionally used in older Fortran programs. +@cindex option, -fdefault-double-8 +@cindex -fdefault-double-8, option +@item -fdefault-double-8 +Set the "DOUBLE PRECISION" type to an 8 byte wide. + +@cindex option, -fdefault-integer-8 +@cindex -fdefault-integer-8, option +@item -fdefault-integer-8 +Set the default integer and logical types to an 8 byte wide type. +Do nothing if this is already the default. + +@cindex option, -fdefault-real-8 +@cindex -fdefault-real-8, option +@item -fdefault-real-8 +Set the default real type to an 8 byte wide type. +Do nothing if this is already the default. + @cindex -fdollar-ok option @cindex options, -fdollar-ok @item -fdollar-ok @@ -233,23 +250,6 @@ Specify that no implicit typing is allowed, unless overridden by explicit Conform to the specified standard. Allowed values for @var{std} are @samp{gnu}, @samp{f95} and @samp{f90}. -@cindex option, -i8 -@cindex -i8, option -@cindex option, -r8 -@cindex -r8, option -@cindex option, -d8 -@cindex -d8, option -@item -i8 -@item -r8 -@item -d8 -The @option{-i8} and @option{-r8} options set the default @code{INTEGER} -and @code{REAL} kinds to @code{KIND=8}. The @option{-d8} option is -equivalent to specifying both @option{-i8} and @option{-r8}. - -When @option{-r8} is specified, the @code{DOUBLE PRECISION} kind is set -to @code{KIND=16} if the target supports a 16 byte floating point format. -If no such format exists, the @code{DOUBLE PRECISION} kind is unchanged. - @end table @node Warning Options @@ -371,8 +371,8 @@ This currently produces a warning under the following circumstances: @itemize @bullet @item -An INTEGER SELECT construct has a CASE the can never be matched as it's -lower value that is greater than its upper value. +An INTEGER SELECT construct has a CASE that can never be matched as its +lower value is greater than its upper value. @item A LOGICAL SELECT construct has three CASE statements. diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 8230fa99cd0..12650f90f24 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -981,6 +981,14 @@ resolve_tag (const io_tag * tag, gfc_expr * e) &e->where); return FAILURE; } + /* Check assigned label. */ + if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_INTEGER + && e->symtree->n.sym->attr.assign != 1) + { + gfc_error ("Variable '%s' has not been assigned a format label at %L", + e->symtree->n.sym->name, &e->where); + return FAILURE; + } } else { @@ -1526,9 +1534,6 @@ match_dt_format (gfc_dt * dt) gfc_free_expr (e); goto conflict; } - if (e->ts.type == BT_INTEGER && e->rank == 0) - e->symtree->n.sym->attr.assign = 1; - dt->format_expr = e; return MATCH_YES; } diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 9a30b7df2e1..746b97df444 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -253,6 +253,31 @@ gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind) void +gfc_resolve_chdir (gfc_expr * f, gfc_expr * d ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("chdir_i%d"), f->ts.kind); +} + + +void +gfc_resolve_chdir_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->expr != NULL) + kind = c->ext.actual->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("chdir_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind) { f->ts.type = BT_COMPLEX; @@ -533,6 +558,14 @@ gfc_resolve_getuid (gfc_expr * f) } void +gfc_resolve_hostnm (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 4; + f->value.function.name = gfc_get_string (PREFIX ("hostnm")); +} + +void gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j) { /* If the kind of i and j are different, then g77 cross-promoted the @@ -596,6 +629,15 @@ gfc_resolve_idnint (gfc_expr * f, gfc_expr * a) void +gfc_resolve_ierrno (gfc_expr * f) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("ierrno_i%d"), f->ts.kind); +} + + +void gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j) { /* If the kind of i and j are different, then g77 cross-promoted the @@ -670,6 +712,17 @@ gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift, void +gfc_resolve_kill (gfc_expr * f, ATTRIBUTE_UNUSED gfc_expr * p, + ATTRIBUTE_UNUSED gfc_expr * s) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + + f->value.function.name = gfc_get_string (PREFIX("kill_i%d"), f->ts.kind); +} + + +void gfc_resolve_lbound (gfc_expr * f, gfc_expr * array, gfc_expr * dim) { @@ -708,6 +761,16 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string) void +gfc_resolve_link (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED, + gfc_expr * p2 ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("link_i%d"), f->ts.kind); +} + + +void gfc_resolve_log (gfc_expr * f, gfc_expr * x) { f->ts = x->ts; @@ -1019,6 +1082,16 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind) void +gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED, + gfc_expr * p2 ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("rename_i%d"), f->ts.kind); +} + + +void gfc_resolve_repeat (gfc_expr * f, gfc_expr * string, gfc_expr * ncopies ATTRIBUTE_UNUSED) { @@ -1275,6 +1348,16 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim, } +void +gfc_resolve_symlnk (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED, + gfc_expr * p2 ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("symlnk_i%d"), f->ts.kind); +} + + /* Resolve the g77 compatibility function SYSTEM. */ void @@ -1305,6 +1388,24 @@ gfc_resolve_tanh (gfc_expr * f, gfc_expr * x) void +gfc_resolve_time (gfc_expr * f) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 4; + f->value.function.name = gfc_get_string (PREFIX("time_func")); +} + + +void +gfc_resolve_time8 (gfc_expr * f) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 8; + f->value.function.name = gfc_get_string (PREFIX("time8_func")); +} + + +void gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED, gfc_expr * mold, gfc_expr * size) { @@ -1490,6 +1591,70 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED) } +void +gfc_resolve_rename_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->next->expr != NULL) + kind = c->ext.actual->next->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("rename_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_kill_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->next->expr != NULL) + kind = c->ext.actual->next->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("kill_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_link_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->next->expr != NULL) + kind = c->ext.actual->next->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("link_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_symlnk_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->next->expr != NULL) + kind = c->ext.actual->next->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("symlnk_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + /* G77 compatibility subroutines etime() and dtime(). */ void @@ -1514,6 +1679,22 @@ gfc_resolve_second_sub (gfc_code * c) } +void +gfc_resolve_sleep_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->expr != NULL) + kind = c->ext.actual->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("sleep_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + /* G77 compatibility function srand(). */ void @@ -1665,6 +1846,43 @@ gfc_resolve_flush (gfc_code * c) c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } + +void +gfc_resolve_gerror (gfc_code * c) +{ + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror")); +} + + +void +gfc_resolve_getlog (gfc_code * c) +{ + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog")); +} + + +void +gfc_resolve_hostnm_sub (gfc_code * c) +{ + const char *name; + int kind; + + if (c->ext.actual->next->expr != NULL) + kind = c->ext.actual->next->expr->ts.kind; + else + kind = gfc_default_integer_kind; + + name = gfc_get_string (PREFIX("hostnm_i%d_sub"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_perror (gfc_code * c) +{ + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub")); +} + /* Resolve the STAT and FSTAT intrinsic subroutines. */ void diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 976a2b436d2..bde1d753b07 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -69,9 +69,17 @@ Wunused-labels F95 Warn when a label is unused -d8 -F95 RejectNegative -Set the default real and integer kinds to double precision +fdefault-double-8 +F95 +Set the default double precision kind to an 8 byte wide type + +fdefault-integer-8 +F95 +Set the default integer kind to an 8 byte wide type + +fdefault-real-8 +F95 +Set the default real kind to an 8 byte wide type fdollar-ok F95 @@ -133,18 +141,10 @@ frepack-arrays F95 Copy array sections into a contiguous block on procedure entry -i8 -F95 -Set the default integer kind to double precision - qkind= F95 RejectNegative Joined UInteger -qkind=<n> Set the kind for a real with the 'q' exponent to 'n' -r8 -F95 -Set the default real kind to double precision - std=f95 F95 Conform to the ISO Fortran 95 standard. diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 2a364478530..f433db52c5d 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1526,7 +1526,6 @@ gfc_match_goto (void) == FAILURE) return MATCH_ERROR; - expr->symtree->n.sym->attr.assign = 1; new_st.op = EXEC_GOTO; new_st.expr = expr; diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 35964003785..21fb0a83c52 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -57,6 +57,9 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.warn_surprising = 0; gfc_option.warn_unused_labels = 0; + gfc_option.flag_default_double = 0; + gfc_option.flag_default_integer = 0; + gfc_option.flag_default_real = 0; gfc_option.flag_dollar_ok = 0; gfc_option.flag_underscoring = 1; gfc_option.flag_second_underscore = 1; @@ -68,9 +71,6 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.flag_repack_arrays = 0; gfc_option.q_kind = gfc_default_double_kind; - gfc_option.i8 = 0; - gfc_option.r8 = 0; - gfc_option.d8 = 0; flag_argument_noalias = 2; flag_errno_math = 0; @@ -285,16 +285,16 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.q_kind = value; break; - case OPT_i8: - gfc_option.i8 = value; + case OPT_fdefault_integer_8: + gfc_option.flag_default_integer = value; break; - case OPT_r8: - gfc_option.r8 = value; + case OPT_fdefault_real_8: + gfc_option.flag_default_real = value; break; - case OPT_d8: - gfc_option.d8 = value; + case OPT_fdefault_double_8: + gfc_option.flag_default_double = value; break; case OPT_I: diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index f3c51ab4675..992bc5f0af7 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -300,17 +300,15 @@ match_boz_constant (gfc_expr ** result) match_digits (0, radix, buffer); gfc_next_char (); /* Eat delimiter. */ - kind = get_kind (); - if (kind == -1) - return MATCH_ERROR; - if (kind == -2) - kind = gfc_default_integer_kind; - else if (pedantic - && (gfc_notify_std (GFC_STD_GNU, "Extension: Kind parameter " - "suffix to boz literal constant at %C.") - == FAILURE)) - return MATCH_ERROR; + /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find + "If a data-stmt-constant is a boz-literal-constant, the corresponding + variable shall be of type integer. The boz-literal-constant is treated + as if it were an int-literal-constant with a kind-param that specifies + the representation method with the largest decimal exponent range + supported by the processor." */ + + kind = gfc_max_integer_kind; e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus); if (gfc_range_check (e) != ARITH_OK) @@ -1076,7 +1074,17 @@ match_complex_constant (gfc_expr ** result) m = gfc_match_char (')'); if (m == MATCH_NO) + { + /* Give the matcher for implied do-loops a chance to run. This + yields a much saner error message for (/ (i, 4=i, 6) /). */ + if (gfc_peek_char () == '=') + { + m = MATCH_ERROR; + goto cleanup; + } + else goto syntax; + } if (m == MATCH_ERROR) goto cleanup; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4d98f462a82..16db94342d1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -481,7 +481,7 @@ was_declared (gfc_symbol * sym) if (!a.implicit_type && sym->ts.type != BT_UNKNOWN) return 1; - if (a.allocatable || a.dimension || a.external || a.intrinsic + if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic || a.optional || a.pointer || a.save || a.target || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN) return 1; @@ -1249,6 +1249,36 @@ resolve_call (gfc_code * c) return t; } +/* Compare the shapes of two arrays that have non-NULL shapes. If both + op1->shape and op2->shape are non-NULL return SUCCESS if their shapes + match. If both op1->shape and op2->shape are non-NULL return FAILURE + if their shapes do not match. If either op1->shape or op2->shape is + NULL, return SUCCESS. */ + +static try +compare_shapes (gfc_expr * op1, gfc_expr * op2) +{ + try t; + int i; + + t = SUCCESS; + + if (op1->shape != NULL && op2->shape != NULL) + { + for (i = 0; i < op1->rank; i++) + { + if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0) + { + gfc_error ("Shapes for operands at %L and %L are not conformable", + &op1->where, &op2->where); + t = FAILURE; + break; + } + } + } + + return t; +} /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ @@ -1460,10 +1490,14 @@ resolve_operator (gfc_expr * e) if (op1->rank == op2->rank) { e->rank = op1->rank; - if (e->shape == NULL) + { + t = compare_shapes(op1, op2); + if (t == FAILURE) + e->shape = NULL; + else e->shape = gfc_copy_shape (op1->shape, op1->rank); - + } } else { @@ -1499,10 +1533,12 @@ resolve_operator (gfc_expr * e) return t; bad_op: + if (gfc_extend_expr (e) == SUCCESS) return SUCCESS; gfc_error (msg, &e->where); + return FAILURE; } @@ -1665,19 +1701,26 @@ gfc_resolve_index (gfc_expr * index, int check_scalar) if (gfc_resolve_expr (index) == FAILURE) return FAILURE; - if (index->ts.type != BT_INTEGER) + if (check_scalar && index->rank != 0) { - gfc_error ("Array index at %L must be of INTEGER type", &index->where); + gfc_error ("Array index at %L must be scalar", &index->where); return FAILURE; } - if (check_scalar && index->rank != 0) + if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL) { - gfc_error ("Array index at %L must be scalar", &index->where); + gfc_error ("Array index at %L must be of INTEGER type", + &index->where); return FAILURE; } - if (index->ts.kind != gfc_index_integer_kind) + if (index->ts.type == BT_REAL) + if (gfc_notify_std (GFC_STD_GNU, "Extension: REAL array index at %L", + &index->where) == FAILURE) + return FAILURE; + + if (index->ts.kind != gfc_index_integer_kind + || index->ts.type != BT_INTEGER) { ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; @@ -3652,10 +3695,17 @@ resolve_code (gfc_code * code, gfc_namespace * ns) break; case EXEC_GOTO: - if (code->expr != NULL && code->expr->ts.type != BT_INTEGER) - gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER " + if (code->expr != NULL) + { + if (code->expr->ts.type != BT_INTEGER) + gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER " "variable", &code->expr->where); - else + else if (code->expr->symtree->n.sym->attr.assign != 1) + gfc_error ("Variable '%s' has not been assigned a target label " + "at %L", code->expr->symtree->n.sym->name, + &code->expr->where); + } + else resolve_branch (code->label, code); break; @@ -4713,10 +4763,11 @@ gfc_resolve (gfc_namespace * ns) if (cl->length == NULL || gfc_resolve_expr (cl->length) == FAILURE) continue; - if (cl->length->ts.type != BT_INTEGER) - gfc_error - ("Character length specification at %L must be of type INTEGER", - &cl->length->where); + if (gfc_simplify_expr (cl->length, 0) == FAILURE) + continue; + + if (gfc_specification_expr (cl->length) == FAILURE) + continue; } gfc_traverse_ns (ns, resolve_values); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 81bc0159909..d6e988b9176 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1766,16 +1766,18 @@ gfc_simplify_kind (gfc_expr * e) static gfc_expr * -gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper) +simplify_bound (gfc_expr * array, gfc_expr * dim, int upper) { gfc_ref *ref; gfc_array_spec *as; - int i; + gfc_expr *e; + int d; if (array->expr_type != EXPR_VARIABLE) return NULL; if (dim == NULL) + /* TODO: Simplify constant multi-dimensional bounds. */ return NULL; if (dim->expr_type != EXPR_CONSTANT) @@ -1783,29 +1785,66 @@ gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper) /* Follow any component references. */ as = array->symtree->n.sym->as; - ref = array->ref; - while (ref->next != NULL) + for (ref = array->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_ARRAY: + switch (ref->u.ar.type) + { + case AR_ELEMENT: + as = NULL; + continue; + + case AR_FULL: + /* We're done because 'as' has already been set in the + previous iteration. */ + goto done; + + case AR_SECTION: + case AR_UNKNOWN: + return NULL; + } + + gcc_unreachable (); + + case REF_COMPONENT: + as = ref->u.c.component->as; + continue; + + case REF_SUBSTRING: + continue; + } + } + + gcc_unreachable (); + + done: + if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE) + return NULL; + + d = mpz_get_si (dim->value.integer); + + if (d < 1 || d > as->rank + || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper)) { - if (ref->type == REF_COMPONENT) - as = ref->u.c.sym->as; - ref = ref->next; + gfc_error ("DIM argument at %L is out of bounds", &dim->where); + return &gfc_bad_expr; } - if (ref->type != REF_ARRAY || ref->u.ar.type != AR_FULL) + e = upper ? as->upper[d-1] : as->lower[d-1]; + + if (e->expr_type != EXPR_CONSTANT) return NULL; - - i = mpz_get_si (dim->value.integer); - if (upper) - return gfc_copy_expr (as->upper[i-1]); - else - return gfc_copy_expr (as->lower[i-1]); + + return gfc_copy_expr (e); } gfc_expr * gfc_simplify_lbound (gfc_expr * array, gfc_expr * dim) { - return gfc_simplify_bound (array, dim, 0); + return simplify_bound (array, dim, 0); } @@ -3578,7 +3617,7 @@ gfc_simplify_trim (gfc_expr * e) gfc_expr * gfc_simplify_ubound (gfc_expr * array, gfc_expr * dim) { - return gfc_simplify_bound (array, dim, 1); + return simplify_bound (array, dim, 1); } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0b5e8e727a4..26e3f003442 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -369,6 +369,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where) { case PROC_ST_FUNCTION: conf2 (in_common); + conf2 (dummy); break; case PROC_MODULE: diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a97bcc593a3..bd77eb46850 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -99,43 +99,6 @@ static gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *); static gfc_ss gfc_ss_terminator_var; gfc_ss * const gfc_ss_terminator = &gfc_ss_terminator_var; -unsigned HOST_WIDE_INT gfc_stack_space_left; - - -/* Returns true if a variable of specified size should go on the stack. */ - -int -gfc_can_put_var_on_stack (tree size) -{ - unsigned HOST_WIDE_INT low; - - if (!INTEGER_CST_P (size)) - return 0; - - if (gfc_option.flag_max_stack_var_size < 0) - return 1; - - if (TREE_INT_CST_HIGH (size) != 0) - return 0; - - low = TREE_INT_CST_LOW (size); - if (low > (unsigned HOST_WIDE_INT) gfc_option.flag_max_stack_var_size) - return 0; - -/* TODO: Set a per-function stack size limit. */ -#if 0 - /* We should be a bit more clever with array temps. */ - if (gfc_option.flag_max_function_vars_size >= 0) - { - if (low > gfc_stack_space_left) - return 0; - - gfc_stack_space_left -= low; - } -#endif - - return 1; -} static tree gfc_array_dataptr_type (tree desc) diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index b4407693909..faaaf5ade4b 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -95,11 +95,6 @@ tree gfc_conv_array_stride (tree, int); tree gfc_conv_array_lbound (tree, int); tree gfc_conv_array_ubound (tree, int); -/* The remaining space available for stack variables. */ -extern unsigned HOST_WIDE_INT gfc_stack_space_left; -/* Returns true if a variable of specified size should go on the stack. */ -int gfc_can_put_var_on_stack (tree); - /* Build expressions for accessing components of an array descriptor. */ tree gfc_conv_descriptor_data (tree); tree gfc_conv_descriptor_offset (tree); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 35ea8012034..42e67123328 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -242,6 +242,27 @@ build_field (segment_info *h, tree union_type, record_layout_info rli) size_binop (PLUS_EXPR, DECL_FIELD_OFFSET (field), DECL_SIZE_UNIT (field))); + /* If this field is assigned to a label, we create another two variables. + One will hold the address of taget label or format label. The other will + hold the length of format label string. */ + if (h->sym->attr.assign) + { + tree len; + tree addr; + + gfc_allocate_lang_decl (field); + GFC_DECL_ASSIGN (field) = 1; + len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name); + addr = gfc_create_var_np (pvoid_type_node, h->sym->name); + TREE_STATIC (len) = 1; + TREE_STATIC (addr) = 1; + DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2); + gfc_set_decl_location (len, &h->sym->declared_at); + gfc_set_decl_location (addr, &h->sym->declared_at); + GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len); + GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr); + } + h->field = field; } @@ -252,6 +273,8 @@ static tree build_equiv_decl (tree union_type, bool is_init) { tree decl; + char name[15]; + static int serial = 0; if (is_init) { @@ -260,10 +283,13 @@ build_equiv_decl (tree union_type, bool is_init) return decl; } - decl = build_decl (VAR_DECL, NULL, union_type); + snprintf (name, sizeof (name), "equiv.%d", serial++); + decl = build_decl (VAR_DECL, get_identifier (name), union_type); DECL_ARTIFICIAL (decl) = 1; + DECL_IGNORED_P (decl) = 1; - DECL_COMMON (decl) = 1; + if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))) + TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; TREE_USED (decl) = 1; @@ -353,7 +379,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) backend declarations for all of the elements. */ static void -create_common (gfc_common_head *com, segment_info * head) +create_common (gfc_common_head *com, segment_info * head, bool saw_equiv) { segment_info *s, *next_s; tree union_type; @@ -362,8 +388,16 @@ create_common (gfc_common_head *com, segment_info * head) tree decl; bool is_init = false; - /* Declare the variables inside the common block. */ - union_type = make_node (UNION_TYPE); + /* Declare the variables inside the common block. + If the current common block contains any equivalence object, then + make a UNION_TYPE node, otherwise RECORD_TYPE. This will let the + alias analyzer work well when there is no address overlapping for + common variables in the current common block. */ + if (saw_equiv) + union_type = make_node (UNION_TYPE); + else + union_type = make_node (RECORD_TYPE); + rli = start_record_layout (union_type); field_link = &TYPE_FIELDS (union_type); @@ -429,7 +463,7 @@ create_common (gfc_common_head *com, segment_info * head) for (s = head; s; s = next_s) { s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field), - decl, s->field, NULL_TREE); + decl, s->field, NULL_TREE); next_s = s->next; gfc_free (s); @@ -677,7 +711,7 @@ find_equivalence (segment_info *n) segment list multiple times to include indirect equivalences. */ static void -add_equivalences (void) +add_equivalences (bool *saw_equiv) { segment_info *f; bool more; @@ -692,6 +726,8 @@ add_equivalences (void) { f->sym->equiv_built = 1; more = find_equivalence (f); + if (more) + *saw_equiv = true; } } } @@ -762,10 +798,12 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) HOST_WIDE_INT current_offset; unsigned HOST_WIDE_INT align; unsigned HOST_WIDE_INT max_align; + bool saw_equiv; common_segment = NULL; current_offset = 0; max_align = 1; + saw_equiv = false; /* Add symbols to the segment. */ for (sym = var_list; sym; sym = sym->common_next) @@ -795,7 +833,7 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) /* Add all objects directly or indirectly equivalenced with this symbol. */ - add_equivalences (); + add_equivalences (&saw_equiv); if (current_segment->offset < 0) gfc_error ("The equivalence set for '%s' cause an invalid " @@ -839,7 +877,7 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) common->name, &common->where, common_segment->offset); } - create_common (common, common_segment); + create_common (common, common_segment, saw_equiv); } @@ -852,6 +890,7 @@ finish_equivalences (gfc_namespace *ns) gfc_symbol *sym; HOST_WIDE_INT offset; unsigned HOST_WIDE_INT align; + bool dummy; for (z = ns->equiv; z; z = z->next) for (y = z->eq; y; y = y->eq) @@ -862,7 +901,7 @@ finish_equivalences (gfc_namespace *ns) current_segment = get_segment_info (sym, 0); /* All objects directly or indirectly equivalenced with this symbol. */ - add_equivalences (); + add_equivalences (&dummy); /* Align the block. */ offset = align_segment (&align); @@ -873,7 +912,7 @@ finish_equivalences (gfc_namespace *ns) apply_segment_offset (current_segment, offset); /* Create the decl. */ - create_common (NULL, current_segment); + create_common (NULL, current_segment, true); break; } } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b81b9862207..08dd72af697 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -317,6 +317,32 @@ gfc_sym_mangled_function_id (gfc_symbol * sym) } +/* Returns true if a variable of specified size should go on the stack. */ + +int +gfc_can_put_var_on_stack (tree size) +{ + unsigned HOST_WIDE_INT low; + + if (!INTEGER_CST_P (size)) + return 0; + + if (gfc_option.flag_max_stack_var_size < 0) + return 1; + + if (TREE_INT_CST_HIGH (size) != 0) + return 0; + + low = TREE_INT_CST_LOW (size); + if (low > (unsigned HOST_WIDE_INT) gfc_option.flag_max_stack_var_size) + return 0; + +/* TODO: Set a per-function stack size limit. */ + + return 1; +} + + /* Finish processing of a declaration and install its initial value. */ static void @@ -533,7 +559,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) /* For some dummy arguments we don't use the actual argument directly. - Instead we create a local decl and use that. This allows us to preform + Instead we create a local decl and use that. This allows us to perform initialization, and construct full type information. */ static tree diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 685a9f97f9e..b79d0743dec 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1220,7 +1220,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, something like x = f() where f is pointer valued, we have to dereference the result. */ - if (sym->attr.pointer && !se->want_pointer && !byref) + if (!se->want_pointer && !byref + && (sym->attr.pointer || (sym->result && sym->result->attr.pointer))) se->expr = gfc_build_indirect_ref (se->expr); /* A pure function may still have side-effects - it may modify its diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index dcabd4112fe..014709327b2 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1032,8 +1032,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) } -/* Create a symbol node for this intrinsic. The symbol form the frontend - is for the generic name. */ +/* Create a symbol node for this intrinsic. The symbol from the frontend + has the generic name. */ static gfc_symbol * gfc_get_symbol_for_expr (gfc_expr * expr) @@ -2649,11 +2649,10 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) } -/* Generate code for the IARGC intrinsic. If args_only is true this is - actually the COMMAND_ARGUMENT_COUNT intrinsic, so return IARGC - 1. */ +/* Generate code for the IARGC intrinsic. */ static void -gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr, bool args_only) +gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr) { tree tmp; tree fndecl; @@ -2667,8 +2666,6 @@ gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr, bool args_only) type = gfc_typenode_for_spec (&expr->ts); tmp = fold_convert (type, tmp); - if (args_only) - tmp = build2 (MINUS_EXPR, type, tmp, build_int_cst (type, 1)); se->expr = tmp; } @@ -2827,7 +2824,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_COMMAND_ARGUMENT_COUNT: - gfc_conv_intrinsic_iargc (se, expr, TRUE); + gfc_conv_intrinsic_iargc (se, expr); break; case GFC_ISYM_CONJG: @@ -2869,7 +2866,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_IARGC: - gfc_conv_intrinsic_iargc (se, expr, FALSE); + gfc_conv_intrinsic_iargc (se, expr); break; case GFC_ISYM_IEOR: @@ -2980,6 +2977,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_bound (se, expr, 1); break; + case GFC_ISYM_CHDIR: case GFC_ISYM_DOT_PRODUCT: case GFC_ISYM_ETIME: case GFC_ISYM_FNUM: @@ -2988,12 +2986,20 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) case GFC_ISYM_GETGID: case GFC_ISYM_GETPID: case GFC_ISYM_GETUID: + case GFC_ISYM_HOSTNM: + case GFC_ISYM_KILL: + case GFC_ISYM_IERRNO: case GFC_ISYM_IRAND: + case GFC_ISYM_LINK: case GFC_ISYM_MATMUL: case GFC_ISYM_RAND: + case GFC_ISYM_RENAME: case GFC_ISYM_SECOND: case GFC_ISYM_STAT: + case GFC_ISYM_SYMLNK: case GFC_ISYM_SYSTEM: + case GFC_ISYM_TIME: + case GFC_ISYM_TIME8: case GFC_ISYM_UMASK: case GFC_ISYM_UNLINK: gfc_conv_intrinsic_funcall (se, expr); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 26f05f1e9fb..416932173de 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -397,7 +397,6 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, tree len; gfc_init_se (&se, NULL); - gfc_conv_expr (&se, e); io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE); len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len, @@ -406,6 +405,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) { + gfc_conv_label_variable (&se, e); msg = gfc_build_cstring_const ("Assigned label is not a format label"); tmp = GFC_DECL_STRING_LEN (se.expr); @@ -417,6 +417,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, } else { + gfc_conv_expr (&se, e); gfc_conv_string_parameter (&se); gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr)); gfc_add_modify_expr (&se.pre, len, se.string_length); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index da074c8b454..ea5da88fe7b 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -80,7 +80,23 @@ gfc_trans_label_here (gfc_code * code) return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here)); } + +/* Given a variable expression which has been ASSIGNed to, find the decl + containing the auxiliary variables. For variables in common blocks this + is a field_decl. */ + +void +gfc_conv_label_variable (gfc_se * se, gfc_expr * expr) +{ + gcc_assert (expr->symtree->n.sym->attr.assign == 1); + gfc_conv_expr (se, expr); + /* Deals with variable in common block. Get the field declaration. */ + if (TREE_CODE (se->expr) == COMPONENT_REF) + se->expr = TREE_OPERAND (se->expr, 1); +} + /* Translate a label assignment statement. */ + tree gfc_trans_label_assign (gfc_code * code) { @@ -95,7 +111,8 @@ gfc_trans_label_assign (gfc_code * code) /* Start a new block. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_expr (&se, code->expr); + gfc_conv_label_variable (&se, code->expr); + len = GFC_DECL_STRING_LEN (se.expr); addr = GFC_DECL_ASSIGN_ADDR (se.expr); @@ -103,6 +120,8 @@ gfc_trans_label_assign (gfc_code * code) if (code->label->defined == ST_LABEL_TARGET) { + /* Shouldn't need to set this flag. Reserve for optimization bug. */ + DECL_ARTIFICIAL (label_tree) = 0; label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); len_tree = integer_minus_one_node; } @@ -140,7 +159,7 @@ gfc_trans_goto (gfc_code * code) /* ASSIGNED GOTO. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_expr (&se, code->expr); + gfc_conv_label_variable (&se, code->expr); assign_error = gfc_build_cstring_const ("Assigned label is not a target label"); tmp = GFC_DECL_STRING_LEN (se.expr); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 7bd0011ce8a..c65048cebe6 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -81,6 +81,7 @@ int gfc_index_integer_kind; /* The default kinds of the various types. */ int gfc_default_integer_kind; +int gfc_max_integer_kind; int gfc_default_real_kind; int gfc_default_double_kind; int gfc_default_character_kind; @@ -135,6 +136,9 @@ gfc_init_kinds (void) i_index += 1; } + /* Set the maximum integer kind. Used with at least BOZ constants. */ + gfc_max_integer_kind = gfc_integer_kinds[i_index - 1].kind; + for (r_index = 0, mode = MIN_MODE_FLOAT; mode <= MAX_MODE_FLOAT; mode++) { const struct real_format *fmt = REAL_MODE_FORMAT (mode); @@ -183,10 +187,10 @@ gfc_init_kinds (void) /* Choose the default integer kind. We choose 4 unless the user directs us otherwise. */ - if (gfc_option.i8) + if (gfc_option.flag_default_integer) { if (!saw_i8) - fatal_error ("integer kind=8 not available for -i8 option"); + fatal_error ("integer kind=8 not available for -fdefault-integer-8 option"); gfc_default_integer_kind = 8; } else if (saw_i4) @@ -195,10 +199,10 @@ gfc_init_kinds (void) gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind; /* Choose the default real kind. Again, we choose 4 when possible. */ - if (gfc_option.r8) + if (gfc_option.flag_default_real) { if (!saw_r8) - fatal_error ("real kind=8 not available for -r8 option"); + fatal_error ("real kind=8 not available for -fdefault-real-8 option"); gfc_default_real_kind = 8; } else if (saw_r4) @@ -206,9 +210,16 @@ gfc_init_kinds (void) else gfc_default_real_kind = gfc_real_kinds[0].kind; - /* Choose the default double kind. If -r8 is specified, we use kind=16, - if it's available, otherwise we do not change anything. */ - if (gfc_option.r8 && saw_r16) + /* Choose the default double kind. If -fdefault-real and -fdefault-double + are specified, we use kind=8, if it's available. If -fdefault-real is + specified without -fdefault-double, we use kind=16, if it's available. + Otherwise we do not change anything. */ + if (gfc_option.flag_default_double && !gfc_option.flag_default_real) + fatal_error ("Use of -fdefault-double-8 requires -fdefault-real-8"); + + if (gfc_option.flag_default_real && gfc_option.flag_default_double && saw_r8) + gfc_default_double_kind = 8; + else if (gfc_option.flag_default_real && saw_r16) gfc_default_double_kind = 16; else if (saw_r4 && saw_r8) gfc_default_double_kind = 8; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index f16e23ccff5..712c530aaee 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -289,6 +289,8 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr); void gfc_conv_expr_reference (gfc_se * se, gfc_expr *); /* Equivalent to convert(type, gfc_conv_expr_val(se, expr)). */ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); +/* Find the decl containing the auxiliary variables for assigned variables. */ +void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr); /* If the value is not constant, Create a temporary and copy the value. */ tree gfc_evaluate_now (tree, stmtblock_t *); @@ -391,6 +393,9 @@ void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *); /* Restore the original variable. */ void gfc_restore_sym (gfc_symbol *, gfc_saved_var *); +/* Returns true if a variable of specified size should go on the stack. */ +int gfc_can_put_var_on_stack (tree); + /* Allocate the lang-spcific part of a decl node. */ void gfc_allocate_lang_decl (tree); |