diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 26 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 3 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 42 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 31 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 1 |
8 files changed, 130 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 922f5ee..ad9aa2c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2004-07-04 Janne Blomqvist <jblomqvi@cc.hut.fi> + Paul Brook <paul@codesourcery.com> + + PR fortran/15280 + PR fortran/15665 + * gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_IARGC and + GFC_ISYM_COMMAND_ARGUMENT_COUNT. + * intrinsic.c (add_functions): Identify iargc. Add + command_argument_count. + (add_subroutines): Resolve getarg. Add get_command and + get_command_argument. + * intrinsic.h (gfc_resolve_getarg, gfc_resolve_get_command, + gfc_resolve_get_command_argument): Add prototypes. + * iresolve.c (gfc_resolve_getarg, gfc_resolve_get_command, + gfc_resolve_get_command_argument): New functions. + * trans-decl.c (gfor_fndecl_iargc): New variable. + (gfc_build_intrinsic_function_decls): Set it. + * trans-intrinsic.c (gfc_conv_intrinsic_iargc): New function. + (gfc_conv_intrinsic_function): Use it. + * trans.h (gfor_fndecl_iargc): Declare. + 2004-07-04 Matthias Klose <doko@debian.org> * Make-lang.in: Generate and install gfortran man page. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 86113ad..54508dc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -291,6 +291,7 @@ enum gfc_generic_isym_id GFC_ISYM_CEILING, GFC_ISYM_CHAR, GFC_ISYM_CMPLX, + GFC_ISYM_COMMAND_ARGUMENT_COUNT, GFC_ISYM_CONJG, GFC_ISYM_COS, GFC_ISYM_COSH, @@ -308,6 +309,7 @@ enum gfc_generic_isym_id GFC_ISYM_FRACTION, GFC_ISYM_IACHAR, GFC_ISYM_IAND, + GFC_ISYM_IARGC, GFC_ISYM_IBCLR, GFC_ISYM_IBITS, GFC_ISYM_IBSET, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 04443d9..258843b 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1104,6 +1104,10 @@ add_functions (void) make_generic ("iand", GFC_ISYM_IAND); add_sym_0 ("iargc", 1, 1, BT_INTEGER, di, NULL, NULL, NULL); /* Extension, takes no arguments */ + make_generic ("iargc", GFC_ISYM_IARGC); + + add_sym_0 ("command_argument_count", 1, 1, BT_INTEGER, di, NULL, NULL, NULL); + make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT); add_sym_2 ("ibclr", 1, 1, BT_INTEGER, di, gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr, @@ -1704,7 +1708,9 @@ add_subroutines (void) *h = "harvest", *dt = "date", *vl = "values", *pt = "put", *c = "count", *tm = "time", *tp = "topos", *gt = "get", *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max", - *f = "from", *sz = "size", *ln = "len", *cr = "count_rate"; + *f = "from", *sz = "size", *ln = "len", *cr = "count_rate", + *com = "command", *length = "length", *st = "status", + *val = "value", *num = "number"; int di, dr, dc; @@ -1738,8 +1744,24 @@ add_subroutines (void) vl, BT_REAL, 4, 0, tm, BT_REAL, 4, 0); add_sym_2 ("getarg", 0, 1, BT_UNKNOWN, 0, - NULL, NULL, NULL, + NULL, NULL, gfc_resolve_getarg, c, BT_INTEGER, di, 0, vl, BT_CHARACTER, dc, 0); + + /* F2003 commandline routines. */ + + add_sym_3s ("get_command", 0, 1, BT_UNKNOWN, 0, + NULL, NULL, gfc_resolve_get_command, + com, BT_CHARACTER, dc, 1, + length, BT_INTEGER, di, 1, + st, BT_INTEGER, di, 1); + + add_sym_4 ("get_command_argument", 0, 1, BT_UNKNOWN, 0, + NULL, NULL, gfc_resolve_get_command_argument, + num, BT_INTEGER, di, 0, + val, BT_CHARACTER, dc, 1, + length, BT_INTEGER, di, 1, + st, BT_INTEGER, di, 1); + /* Extension */ add_sym_5 ("mvbits", 1, 1, BT_UNKNOWN, 0, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index c345abc..2d759cf 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -315,6 +315,9 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_cpu_time (gfc_code *); void gfc_resolve_system_clock(gfc_code *); void gfc_resolve_random_number (gfc_code *); +void gfc_resolve_getarg (gfc_code *); +void gfc_resolve_get_command (gfc_code *); +void gfc_resolve_get_command_argument (gfc_code *); /* The mvbits() subroutine requires the most arguments: five. */ diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 2d8fffd..f7e7f71 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1408,6 +1408,48 @@ gfc_resolve_srand (gfc_code * c) } +/* Resolve the getarg intrinsic subroutine. */ + +void +gfc_resolve_getarg (gfc_code * c) +{ + const char *name; + int kind; + + kind = gfc_default_integer_kind (); + name = gfc_get_string (PREFIX("getarg_i%d"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +/* Resolve the get_command intrinsic subroutine. */ + +void +gfc_resolve_get_command (gfc_code * c) +{ + const char *name; + int kind; + + kind = gfc_default_integer_kind (); + name = gfc_get_string (PREFIX("get_command_i%d"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +/* Resolve the get_command_argument intrinsic subroutine. */ + +void +gfc_resolve_get_command_argument (gfc_code * c) +{ + const char *name; + int kind; + + kind = gfc_default_integer_kind (); + name = gfc_get_string (PREFIX("get_command_argument_i%d"), kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + /* Determine if the arguments to SYSTEM_CLOCK are INTEGER(4) or INTEGER(8) */ void diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 480a8be..47d9ba5 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -125,6 +125,7 @@ tree gfor_fndecl_adjustr; tree gfor_fndecl_size0; tree gfor_fndecl_size1; +tree gfor_fndecl_iargc; /* Intrinsic functions implemented in FORTRAN. */ tree gfor_fndecl_si_kind; @@ -1518,6 +1519,11 @@ gfc_build_intrinsic_function_decls (void) gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type); + + gfor_fndecl_iargc = + gfc_build_library_function_decl (get_identifier (PREFIX ("iargc")), + gfc_int4_type_node, + 0); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 37a6a05..1151da9 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2585,6 +2585,29 @@ 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. */ + +static void +gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr, bool args_only) +{ + tree tmp; + tree fndecl; + tree type; + + /* Call the library function. This always returns an INTEGER(4). */ + fndecl = gfor_fndecl_iargc; + tmp = gfc_build_function_call (fndecl, NULL_TREE); + + /* Convert it to the required type. */ + type = gfc_typenode_for_spec (&expr->ts); + tmp = fold_convert (type, tmp); + + if (args_only) + tmp = build (MINUS_EXPR, type, tmp, convert (type, integer_one_node)); + se->expr = tmp; +} + /* Generate code for an intrinsic function. Some map directly to library calls, others get special handling. In some cases the name of the function used depends on the type specifiers. */ @@ -2739,6 +2762,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_cmplx (se, expr, name[5] == '1'); break; + case GFC_ISYM_COMMAND_ARGUMENT_COUNT: + gfc_conv_intrinsic_iargc (se, expr, TRUE); + break; + case GFC_ISYM_CONJG: gfc_conv_intrinsic_conjg (se, expr); break; @@ -2777,6 +2804,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_ichar (se, expr); break; + case GFC_ISYM_IARGC: + gfc_conv_intrinsic_iargc (se, expr, FALSE); + break; + case GFC_ISYM_IEOR: gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR); break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index c4d8df4..6119e58 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -481,6 +481,7 @@ extern GTY(()) tree gfor_fndecl_adjustr; /* Other misc. runtime library functions. */ extern GTY(()) tree gfor_fndecl_size0; extern GTY(()) tree gfor_fndecl_size1; +extern GTY(()) tree gfor_fndecl_iargc; /* Implemented in FORTRAN. */ extern GTY(()) tree gfor_fndecl_si_kind; |