libgfortran/intrinsics/args.c

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