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