libgfortran/intrinsics/args.c

   1 /* Implementation of the GETARG and IARGC g77, and
   2    corresponding F2003, intrinsics.
   3    Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc.
   4    Contributed by Bud Davis and Janne Blomqvist.
   5
   6 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   7
   8 Libgfortran is free software; you can redistribute it and/or
   9 modify it under the terms of the GNU General Public
  10 License as published by the Free Software Foundation; either
  11 version 2 of the License, or (at your option) any later version.
  12
  13 In addition to the permissions in the GNU General Public License, the
  14 Free Software Foundation gives you unlimited permission to link the
  15 compiled version of this file into combinations with other programs,
  16 and to distribute those combinations without any restriction coming
  17 from the use of this file.  (The General Public License restrictions
  18 do apply in other respects; for example, they cover modification of
  19 the file, and distribution when not linked into a combine
  20 executable.)
  21
  22 Libgfortran is distributed in the hope that it will be useful,
  23 but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 GNU General Public License for more details.
  26
  27 You should have received a copy of the GNU General Public
  28 License along with libgfortran; see the file COPYING.  If not,
  29 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 Boston, MA 02110-1301, USA.  */
  31
  32 #include "libgfortran.h"
  33 #include <string.h>
  34
  35
  36 /* Get a commandline argument.  */
  37
  38 extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
  39 iexport_proto(getarg_i4);
  40
  41 void
  42 getarg_i4 (GFC_INTEGER_4 *pos, char  *val, gfc_charlen_type val_len)
  43 {
  44   int argc;
  45   int arglen;
  46   char **argv;
  47
  48   get_args (&argc, &argv);
  49
  50   if (val_len < 1 || !val )
  51     return;   /* something is wrong , leave immediately */
  52
  53   memset (val, ' ', val_len);
  54
  55   if ((*pos) + 1 <= argc  && *pos >=0 )
  56     {
  57       arglen = strlen (argv[*pos]);
  58       if (arglen > val_len)
  59         arglen = val_len;
  60       memcpy (val, argv[*pos], arglen);
  61     }
  62 }
  63 iexport(getarg_i4);
  64
  65
  66 /* INTEGER*8 wrapper of getarg.  */
  67
  68 extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
  69 export_proto (getarg_i8);
  70
  71 void
  72 getarg_i8 (GFC_INTEGER_8 *pos, char  *val, gfc_charlen_type val_len)
  73 {
  74   GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
  75   getarg_i4 (&pos4, val, val_len);
  76 }
  77
  78
  79 /* Return the number of commandline arguments.  The g77 info page
  80    states that iargc does not include the specification of the
  81    program name itself.  */
  82
  83 extern GFC_INTEGER_4 iargc (void);
  84 export_proto(iargc);
  85
  86 GFC_INTEGER_4
  87 iargc (void)
  88 {
  89   int argc;
  90   char **argv;
  91
  92   get_args (&argc, &argv);
  93
  94   return (argc - 1);
  95 }
  96
  97
  98 /* F2003 intrinsic functions and subroutines related to command line
  99    arguments.
 100
 101    - function command_argument_count() is converted to iargc by the compiler.
 102
 103    - subroutine get_command([command, length, status]).
 104
 105    - subroutine get_command_argument(number, [value, length, status]).
 106 */
 107
 108 /* These two status codes are specified in the standard. */
 109 #define GFC_GC_SUCCESS 0
 110 #define GFC_GC_VALUE_TOO_SHORT -1
 111
 112 /* Processor-specific status failure code. */
 113 #define GFC_GC_FAILURE 42
 114
 115
 116 extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
 117                                      GFC_INTEGER_4 *, gfc_charlen_type);
 118 iexport_proto(get_command_argument_i4);
 119
 120 /* Get a single commandline argument.  */
 121
 122 void
 123 get_command_argument_i4 (GFC_INTEGER_4 *number, char *value,
 124                          GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 125                          gfc_charlen_type value_len)
 126 {
 127   int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
 128   char **argv;
 129
 130   if (number == NULL )
 131     /* Should never happen.  */
 132     runtime_error ("Missing argument to get_command_argument");
 133
 134   if (value == NULL && length == NULL && status == NULL)
 135     return; /* No need to do anything.  */
 136
 137   get_args (&argc, &argv);
 138
 139   if (*number < 0 || *number >= argc)
 140     stat_flag = GFC_GC_FAILURE;
 141   else
 142     arglen = strlen(argv[*number]);
 143
 144   if (value != NULL)
 145     {
 146       if (value_len < 1)
 147         stat_flag = GFC_GC_FAILURE;
 148       else
 149         memset (value, ' ', value_len);
 150     }
 151
 152   if (value != NULL && stat_flag != GFC_GC_FAILURE)
 153     {
 154       if (arglen > value_len)
 155        {
 156          arglen = value_len;
 157          stat_flag = GFC_GC_VALUE_TOO_SHORT;
 158        }
 159       memcpy (value, argv[*number], arglen);
 160     }
 161
 162   if (length != NULL)
 163     *length = arglen;
 164
 165   if (status != NULL)
 166     *status = stat_flag;
 167 }
 168 iexport(get_command_argument_i4);
 169
 170
 171 /* INTEGER*8 wrapper for get_command_argument.  */
 172
 173 extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *,
 174                                      GFC_INTEGER_8 *, gfc_charlen_type);
 175 export_proto(get_command_argument_i8);
 176
 177 void
 178 get_command_argument_i8 (GFC_INTEGER_8 *number, char *value,
 179                          GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 180                          gfc_charlen_type value_len)
 181 {
 182   GFC_INTEGER_4 number4;
 183   GFC_INTEGER_4 length4;
 184   GFC_INTEGER_4 status4;
 185
 186   number4 = (GFC_INTEGER_4) *number;
 187   get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
 188   if (length)
 189     *length = length4;
 190   if (status)
 191     *status = status4;
 192 }
 193
 194
 195 /* Return the whole commandline.  */
 196
 197 extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
 198                             gfc_charlen_type);
 199 iexport_proto(get_command_i4);
 200
 201 void
 202 get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 203                 gfc_charlen_type command_len)
 204 {
 205   int i, argc, arglen, thisarg;
 206   int stat_flag = GFC_GC_SUCCESS;
 207   int tot_len = 0;
 208   char **argv;
 209
 210   if (command == NULL && length == NULL && status == NULL)
 211     return; /* No need to do anything.  */
 212
 213   get_args (&argc, &argv);
 214
 215   if (command != NULL)
 216     {
 217       /* Initialize the string to blanks.  */
 218       if (command_len < 1)
 219         stat_flag = GFC_GC_FAILURE;
 220       else
 221         memset (command, ' ', command_len);
 222     }
 223
 224   for (i = 0; i < argc ; i++)
 225     {
 226       arglen = strlen(argv[i]);
 227
 228       if (command != NULL && stat_flag == GFC_GC_SUCCESS)
 229         {
 230           thisarg = arglen;
 231           if (tot_len + thisarg > command_len)
 232             {
 233               thisarg = command_len - tot_len; /* Truncate.  */
 234               stat_flag = GFC_GC_VALUE_TOO_SHORT;
 235             }
 236           /* Also a space before the next arg.  */
 237           else if (i != argc - 1 && tot_len + arglen == command_len)
 238             stat_flag = GFC_GC_VALUE_TOO_SHORT;
 239
 240           memcpy (&command[tot_len], argv[i], thisarg);
 241         }
 242
 243       /* Add the legth of the argument.  */
 244       tot_len += arglen;
 245       if (i != argc - 1)
 246         tot_len++;
 247     }
 248
 249   if (length != NULL)
 250     *length = tot_len;
 251
 252   if (status != NULL)
 253     *status = stat_flag;
 254 }
 255 iexport(get_command_i4);
 256
 257
 258 /* INTEGER*8 wrapper for get_command.  */
 259
 260 extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
 261                             gfc_charlen_type);
 262 export_proto(get_command_i8);
 263
 264 void
 265 get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 266                 gfc_charlen_type command_len)
 267 {
 268   GFC_INTEGER_4 length4;
 269   GFC_INTEGER_4 status4;
 270
 271   get_command_i4 (command, &length4, &status4, command_len);
 272   if (length)
 273     *length = length4;
 274   if (status)
 275     *status = status4;
 276 }