libgfortran/intrinsics/args.c

   1 /* Implementation of the GETARG and IARGC g77, and
   2    corresponding F2003, intrinsics.
   3    Copyright (C) 2004, 2005 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 "config.h"
  33 #include <string.h>
  34 #include "libgfortran.h"
  35
  36
  37 /* Get a commandline argument.  */
  38
  39 extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
  40 iexport_proto(getarg_i4);
  41
  42 void
  43 getarg_i4 (GFC_INTEGER_4 *pos, char  *val, gfc_charlen_type val_len)
  44 {
  45   int argc;
  46   int arglen;
  47   char **argv;
  48
  49   get_args (&argc, &argv);
  50
  51   if (val_len < 1 || !val )
  52     return;   /* something is wrong , leave immediately */
  53
  54   memset (val, ' ', val_len);
  55
  56   if ((*pos) + 1 <= argc  && *pos >=0 )
  57     {
  58       arglen = strlen (argv[*pos]);
  59       if (arglen > val_len)
  60         arglen = val_len;
  61       memcpy (val, argv[*pos], arglen);
  62     }
  63 }
  64 iexport(getarg_i4);
  65
  66
  67 /* INTEGER*8 wrapper of getarg.  */
  68
  69 extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
  70 export_proto (getarg_i8);
  71
  72 void
  73 getarg_i8 (GFC_INTEGER_8 *pos, char  *val, gfc_charlen_type val_len)
  74 {
  75   GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
  76   getarg_i4 (&pos4, val, val_len);
  77 }
  78
  79
  80 /* Return the number of commandline arguments.  The g77 info page
  81    states that iargc does not include the specification of the
  82    program name itself.  */
  83
  84 extern GFC_INTEGER_4 iargc (void);
  85 export_proto(iargc);
  86
  87 GFC_INTEGER_4
  88 iargc (void)
  89 {
  90   int argc;
  91   char **argv;
  92
  93   get_args (&argc, &argv);
  94
  95   return (argc - 1);
  96 }
  97
  98
  99 /* F2003 intrinsic functions and subroutines related to command line
 100    arguments.
 101
 102    - function command_argument_count() is converted to iargc by the compiler.
 103
 104    - subroutine get_command([command, length, status]).
 105
 106    - subroutine get_command_argument(number, [value, length, status]).
 107 */
 108
 109 /* These two status codes are specified in the standard. */
 110 #define GFC_GC_SUCCESS 0
 111 #define GFC_GC_VALUE_TOO_SHORT -1
 112
 113 /* Processor-specific status failure code. */
 114 #define GFC_GC_FAILURE 42
 115
 116
 117 extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
 118                                      GFC_INTEGER_4 *, gfc_charlen_type);
 119 iexport_proto(get_command_argument_i4);
 120
 121 /* Get a single commandline argument.  */
 122
 123 void
 124 get_command_argument_i4 (GFC_INTEGER_4 *number, char *value,
 125                          GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 126                          gfc_charlen_type value_len)
 127 {
 128   int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
 129   char **argv;
 130
 131   if (number == NULL )
 132     /* Should never happen.  */
 133     runtime_error ("Missing argument to get_command_argument");
 134
 135   if (value == NULL && length == NULL && status == NULL)
 136     return; /* No need to do anything.  */
 137
 138   get_args (&argc, &argv);
 139
 140   if (*number < 0 || *number >= argc)
 141     stat_flag = GFC_GC_FAILURE;
 142   else
 143     arglen = strlen(argv[*number]);
 144
 145   if (value != NULL)
 146     {
 147       if (value_len < 1)
 148         stat_flag = GFC_GC_FAILURE;
 149       else
 150         memset (value, ' ', value_len);
 151     }
 152
 153   if (value != NULL && stat_flag != GFC_GC_FAILURE)
 154     {
 155       if (arglen > value_len)
 156        {
 157          arglen = value_len;
 158          stat_flag = GFC_GC_VALUE_TOO_SHORT;
 159        }
 160       memcpy (value, argv[*number], arglen);
 161     }
 162
 163   if (length != NULL)
 164     *length = arglen;
 165
 166   if (status != NULL)
 167     *status = stat_flag;
 168 }
 169 iexport(get_command_argument_i4);
 170
 171
 172 /* INTEGER*8 wrapper for get_command_argument.  */
 173
 174 extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *,
 175                                      GFC_INTEGER_8 *, gfc_charlen_type);
 176 export_proto(get_command_argument_i8);
 177
 178 void
 179 get_command_argument_i8 (GFC_INTEGER_8 *number, char *value,
 180                          GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 181                          gfc_charlen_type value_len)
 182 {
 183   GFC_INTEGER_4 number4;
 184   GFC_INTEGER_4 length4;
 185   GFC_INTEGER_4 status4;
 186
 187   number4 = (GFC_INTEGER_4) *number;
 188   get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
 189   if (length)
 190     *length = length4;
 191   if (status)
 192     *status = status4;
 193 }
 194
 195
 196 /* Return the whole commandline.  */
 197
 198 extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
 199                             gfc_charlen_type);
 200 iexport_proto(get_command_i4);
 201
 202 void
 203 get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 204                 gfc_charlen_type command_len)
 205 {
 206   int i, argc, arglen, thisarg;
 207   int stat_flag = GFC_GC_SUCCESS;
 208   int tot_len = 0;
 209   char **argv;
 210
 211   if (command == NULL && length == NULL && status == NULL)
 212     return; /* No need to do anything.  */
 213
 214   get_args (&argc, &argv);
 215
 216   if (command != NULL)
 217     {
 218       /* Initialize the string to blanks.  */
 219       if (command_len < 1)
 220         stat_flag = GFC_GC_FAILURE;
 221       else
 222         memset (command, ' ', command_len);
 223     }
 224
 225   for (i = 0; i < argc ; i++)
 226     {
 227       arglen = strlen(argv[i]);
 228
 229       if (command != NULL && stat_flag == GFC_GC_SUCCESS)
 230         {
 231           thisarg = arglen;
 232           if (tot_len + thisarg > command_len)
 233             {
 234               thisarg = command_len - tot_len; /* Truncate.  */
 235               stat_flag = GFC_GC_VALUE_TOO_SHORT;
 236             }
 237           /* Also a space before the next arg.  */
 238           else if (i != argc - 1 && tot_len + arglen == command_len)
 239             stat_flag = GFC_GC_VALUE_TOO_SHORT;
 240
 241           memcpy (&command[tot_len], argv[i], thisarg);
 242         }
 243
 244       /* Add the legth of the argument.  */
 245       tot_len += arglen;
 246       if (i != argc - 1)
 247         tot_len++;
 248     }
 249
 250   if (length != NULL)
 251     *length = tot_len;
 252
 253   if (status != NULL)
 254     *status = stat_flag;
 255 }
 256 iexport(get_command_i4);
 257
 258
 259 /* INTEGER*8 wrapper for get_command.  */
 260
 261 extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
 262                             gfc_charlen_type);
 263 export_proto(get_command_i8);
 264
 265 void
 266 get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 267                 gfc_charlen_type command_len)
 268 {
 269   GFC_INTEGER_4 length4;
 270   GFC_INTEGER_4 status4;
 271
 272   get_command_i4 (command, &length4, &status4, command_len);
 273   if (length)
 274     *length = length4;
 275   if (status)
 276     *status = status4;
 277 }