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 <paul@codesourcery.com>

From-SVN: r84087

gcc/fortran/ChangeLog

+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.

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,

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,

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.  */

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

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);
 }
 
 

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;

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;

libgfortran/ChangeLog

+2004-07-04  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+	Paul Brook  <paul@codesourcery.com>
+
+	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  <doko@debian.org>
 
 	* libtool-version: New.

libgfortran/intrinsics/args.c

-/* 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 <string.h>
 #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;
+}

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)