From b41b25345b30416cc308c8b412a81542e2fe00f3 Mon Sep 17 00:00:00 2001 From: Janne Blomqvist Date: Sun, 4 Jul 2004 20:00:12 +0300 Subject: [PATCH] re PR libfortran/15280 (Fortran9x commandline not accessable) 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. libgfortran/ * libgfortran.h (gfc_strlen_type): Define. * intrinsics/args.c (getarg): Rename ... (getarg_i4): ... to this. (getarg_i8, get_command_argument_i4, get_command_argument_i8, get_command_i4, get_command_i8): New functions. Co-Authored-By: Paul Brook From-SVN: r84087 --- gcc/fortran/ChangeLog | 21 ++++ gcc/fortran/gfortran.h | 2 + gcc/fortran/intrinsic.c | 26 ++++- gcc/fortran/intrinsic.h | 3 + gcc/fortran/iresolve.c | 42 +++++++ gcc/fortran/trans-decl.c | 6 + gcc/fortran/trans-intrinsic.c | 31 ++++++ gcc/fortran/trans.h | 1 + libgfortran/ChangeLog | 11 ++ libgfortran/intrinsics/args.c | 200 +++++++++++++++++++++++++++++++++- libgfortran/libgfortran.h | 1 + 11 files changed, 338 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 922f5ee2a6b..ad9aa2ca59b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2004-07-04 Janne Blomqvist + Paul Brook + + 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 * Make-lang.in: Generate and install gfortran man page. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 86113ad0495..54508dc590e 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 04443d92ae1..258843bad05 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 c345abc8eaa..2d759cf5a9d 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 2d8fffd4558..f7e7f71427e 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 480a8be563d..47d9ba53a5a 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 37a6a05761e..1151da95256 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 c4d8df47d77..6119e587129 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; diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 056e1232730..ed0044d04e7 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2004-07-04 Janne Blomqvist + Paul Brook + + PR fortran/15280 + PR fortran/15665 + * libgfortran.h (gfc_strlen_type): Define. + * intrinsics/args.c (getarg): Rename ... + (getarg_i4): ... to this. + (getarg_i8, get_command_argument_i4, get_command_argument_i8, + get_command_i4, get_command_i8): New functions. + 2004-07-04 Matthias Klose * libtool-version: New. diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c index da684fd99d4..caa55d46d8b 100644 --- a/libgfortran/intrinsics/args.c +++ b/libgfortran/intrinsics/args.c @@ -1,5 +1,7 @@ -/* Implementation of the IARG/ARGC intrinsic(s). +/* Implementation of the GETARG and IARGC g77, and + corresponding F2003, intrinsics. Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Bud Davis and Janne Blomqvist. This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -23,8 +25,11 @@ Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" + +/* Get a commandline argument. */ + void -prefix(getarg) (GFC_INTEGER_4 *pos, char *val, GFC_INTEGER_4 val_len) +prefix(getarg_i4) (GFC_INTEGER_4 *pos, char *val, gfc_strlen_type val_len) { int argc; int arglen; @@ -35,7 +40,7 @@ prefix(getarg) (GFC_INTEGER_4 *pos, char *val, GFC_INTEGER_4 val_len) if (val_len < 1 || !val ) return; /* something is wrong , leave immediately */ - memset( val, ' ', val_len); + memset (val, ' ', val_len); if ((*pos) + 1 <= argc && *pos >=0 ) { @@ -46,8 +51,23 @@ prefix(getarg) (GFC_INTEGER_4 *pos, char *val, GFC_INTEGER_4 val_len) } } + +/* INTEGER*8 wrapper of getarg. */ + +void +prefix(getarg_i8) (GFC_INTEGER_8 *pos, char *val, gfc_strlen_type val_len) +{ + GFC_INTEGER_4 pos4; + + pos4 = (GFC_INTEGER_4) *pos; + prefix(getarg_i4) (&pos4, val, val_len); +} + + +/* Return the number of commandline arguments. */ + GFC_INTEGER_4 -prefix(iargc) () +prefix(iargc) (void) { int argc; char **argv; @@ -56,3 +76,175 @@ prefix(iargc) () return argc; } + + +/* F2003 intrinsic functions and subroutines related to command line + arguments. + + - function command_argument_count() is converted to iargc by the compiler. + + - subroutine get_command([command, length, status]). + + - subroutine get_command_argument(number, [value, length, status]). +*/ + +/* These two status codes are specified in the standard. */ +#define GFC_GC_SUCCESS 0 +#define GFC_GC_VALUE_TOO_SHORT -1 + +/* Processor-specific status failure code. */ +#define GFC_GC_FAILURE 42 + + +/* Get a single commandline argument. */ + +void +prefix(get_command_argument_i4) (GFC_INTEGER_4 *number, + char *value, + GFC_INTEGER_4 *length, + GFC_INTEGER_4 *status, + gfc_strlen_type value_len) +{ + int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS; + char **argv; + + if (number == NULL ) + /* Should never happen. */ + runtime_error ("Missing argument to get_command_argument"); + + if (value == NULL && length == NULL && status == NULL) + return; /* No need to do anything. */ + + get_args (&argc, &argv); + + if (*number < 0 || *number >= argc) + stat_flag = GFC_GC_FAILURE; + else + arglen = strlen(argv[*number]); + + if (value != NULL) + { + if (value_len < 1) + stat_flag = GFC_GC_FAILURE; + else + memset (value, ' ', value_len); + } + + if (value != NULL && stat_flag != GFC_GC_FAILURE) + { + if (arglen > value_len) + { + arglen = value_len; + stat_flag = GFC_GC_VALUE_TOO_SHORT; + } + memcpy (value, argv[*number], arglen); + } + + if (length != NULL) + *length = arglen; + + if (status != NULL) + *status = stat_flag; +} + + +/* INTEGER*8 wrapper for get_command_argument. */ + +void +prefix(get_command_argument_i8) (GFC_INTEGER_8 *number, + char *value, + GFC_INTEGER_8 *length, + GFC_INTEGER_8 *status, + gfc_strlen_type value_len) +{ + GFC_INTEGER_4 number4; + GFC_INTEGER_4 length4; + GFC_INTEGER_4 status4; + + number4 = (GFC_INTEGER_4) *number; + prefix (get_command_argument_i4) (&number4, value, &length4, &status4, + value_len); + if (length) + *length = length4; + if (status) + *status = status4; +} + + +/* Return the whole commandline. */ + +void +prefix(get_command_i4) (char *command, + GFC_INTEGER_4 *length, + GFC_INTEGER_4 *status, + gfc_strlen_type command_len) +{ + int i, argc, arglen, thisarg; + int stat_flag = GFC_GC_SUCCESS; + int tot_len = 0; + char **argv; + + if (command == NULL && length == NULL && status == NULL) + return; /* No need to do anything. */ + + get_args (&argc, &argv); + + if (command != NULL) + { + /* Initialize the string to blanks. */ + if (command_len < 1) + stat_flag = GFC_GC_FAILURE; + else + memset (command, ' ', command_len); + } + + for (i = 0; i < argc ; i++) + { + arglen = strlen(argv[i]); + + if (command != NULL && stat_flag == GFC_GC_SUCCESS) + { + thisarg = arglen; + if (tot_len + thisarg > command_len) + { + thisarg = command_len - tot_len; /* Truncate. */ + stat_flag = GFC_GC_VALUE_TOO_SHORT; + } + /* Also a space before the next arg. */ + else if (i != argc - 1 && tot_len + arglen == command_len) + stat_flag = GFC_GC_VALUE_TOO_SHORT; + + memcpy (&command[tot_len], argv[i], thisarg); + } + + /* Add the legth of the argument. */ + tot_len += arglen; + if (i != argc - 1) + tot_len++; + } + + if (length != NULL) + *length = tot_len; + + if (status != NULL) + *status = stat_flag; +} + + +/* INTEGER*8 wrapper for get_command. */ + +void +prefix(get_command_i8) (char *command, + GFC_INTEGER_8 *length, + GFC_INTEGER_8 *status, + gfc_strlen_type command_len) +{ + GFC_INTEGER_4 length4; + GFC_INTEGER_4 status4; + + prefix (get_command_i4) (command, &length4, &status4, command_len); + if (length) + *length = length4; + if (status) + *status = status4; +} diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 3e1357fc794..c0406aaffed 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -88,6 +88,7 @@ typedef complex float GFC_COMPLEX_4; typedef complex double GFC_COMPLEX_8; typedef size_t index_type; +typedef GFC_INTEGER_4 gfc_strlen_type; /* This will be 0 on little-endian machines and one on big-endian machines. */ #define l8_to_l4_offset prefix(l8_to_l4_offset) -- 2.30.2