libgfortran/intrinsics/args.c

   1 /* Implementation of the GETARG and IARGC g77, and
   2    corresponding F2003, intrinsics.
   3    Copyright (C) 2004 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 Lesser General Public
  10 License as published by the Free Software Foundation; either
  11 version 2.1 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 Lesser General Public License for more details.
  17
  18 You should have received a copy of the GNU Lesser General Public
  19 License along with libgfor; see the file COPYING.LIB.  If not,
  20 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 #include "config.h"
  24 #include <sys/types.h>
  25 #include <string.h>
  26 #include "libgfortran.h"
  27
  28
  29 /* Get a commandline argument.  */
  30
  31 void
  32 prefix(getarg_i4) (GFC_INTEGER_4 *pos, char  *val, gfc_charlen_type val_len)
  33 {
  34   int argc;
  35   int arglen;
  36   char **argv;
  37
  38   get_args (&argc, &argv);
  39
  40   if (val_len < 1 || !val )
  41     return;   /* something is wrong , leave immediately */
  42
  43   memset (val, ' ', val_len);
  44
  45   if ((*pos) + 1 <= argc  && *pos >=0 )
  46     {
  47       arglen = strlen (argv[*pos]);
  48       if (arglen > val_len)
  49         arglen = val_len;
  50       memcpy (val, argv[*pos], arglen);
  51     }
  52 }
  53
  54
  55 /* INTEGER*8 wrapper of getarg.  */
  56
  57 void
  58 prefix(getarg_i8) (GFC_INTEGER_8 *pos, char  *val, gfc_charlen_type val_len)
  59 {
  60   GFC_INTEGER_4 pos4;
  61
  62   pos4 = (GFC_INTEGER_4) *pos;
  63   prefix(getarg_i4) (&pos4, val, val_len);
  64 }
  65
  66
  67 /* Return the number of commandline arguments.  */
  68
  69 GFC_INTEGER_4
  70 prefix(iargc) (void)
  71 {
  72   int argc;
  73   char **argv;
  74
  75   get_args (&argc, &argv);
  76
  77   return argc;
  78 }
  79
  80
  81 /* F2003 intrinsic functions and subroutines related to command line
  82    arguments.
  83
  84    - function command_argument_count() is converted to iargc by the compiler.
  85
  86    - subroutine get_command([command, length, status]).
  87
  88    - subroutine get_command_argument(number, [value, length, status]).
  89 */
  90
  91 /* These two status codes are specified in the standard. */
  92 #define GFC_GC_SUCCESS 0
  93 #define GFC_GC_VALUE_TOO_SHORT -1
  94
  95 /* Processor-specific status failure code. */
  96 #define GFC_GC_FAILURE 42
  97
  98
  99 /* Get a single commandline argument.  */
 100
 101 void
 102 prefix(get_command_argument_i4) (GFC_INTEGER_4 *number,
 103                                  char *value,
 104                                  GFC_INTEGER_4 *length,
 105                                  GFC_INTEGER_4 *status,
 106                                  gfc_charlen_type value_len)
 107 {
 108   int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
 109   char **argv;
 110
 111   if (number == NULL )
 112     /* Should never happen.  */
 113     runtime_error ("Missing argument to get_command_argument");
 114
 115   if (value == NULL && length == NULL && status == NULL)
 116     return; /* No need to do anything.  */
 117
 118   get_args (&argc, &argv);
 119
 120   if (*number < 0 || *number >= argc)
 121     stat_flag = GFC_GC_FAILURE;
 122   else
 123     arglen = strlen(argv[*number]);
 124
 125   if (value != NULL)
 126     {
 127       if (value_len < 1)
 128         stat_flag = GFC_GC_FAILURE;
 129       else
 130         memset (value, ' ', value_len);
 131     }
 132
 133   if (value != NULL && stat_flag != GFC_GC_FAILURE)
 134     {
 135       if (arglen > value_len)
 136        {
 137          arglen = value_len;
 138          stat_flag = GFC_GC_VALUE_TOO_SHORT;
 139        }
 140       memcpy (value, argv[*number], arglen);
 141     }
 142
 143   if (length != NULL)
 144     *length = arglen;
 145
 146   if (status != NULL)
 147     *status = stat_flag;
 148 }
 149
 150
 151 /* INTEGER*8 wrapper for get_command_argument.  */
 152
 153 void
 154 prefix(get_command_argument_i8) (GFC_INTEGER_8 *number,
 155                                  char *value,
 156                                  GFC_INTEGER_8 *length,
 157                                  GFC_INTEGER_8 *status,
 158                                  gfc_charlen_type value_len)
 159 {
 160   GFC_INTEGER_4 number4;
 161   GFC_INTEGER_4 length4;
 162   GFC_INTEGER_4 status4;
 163
 164   number4 = (GFC_INTEGER_4) *number;
 165   prefix (get_command_argument_i4) (&number4, value, &length4, &status4,
 166                                     value_len);
 167   if (length)
 168     *length = length4;
 169   if (status)
 170     *status = status4;
 171 }
 172
 173
 174 /* Return the whole commandline.  */
 175
 176 void
 177 prefix(get_command_i4) (char *command,
 178                         GFC_INTEGER_4 *length,
 179                         GFC_INTEGER_4 *status,
 180                         gfc_charlen_type command_len)
 181 {
 182   int i, argc, arglen, thisarg;
 183   int stat_flag = GFC_GC_SUCCESS;
 184   int tot_len = 0;
 185   char **argv;
 186
 187   if (command == NULL && length == NULL && status == NULL)
 188     return; /* No need to do anything.  */
 189
 190   get_args (&argc, &argv);
 191
 192   if (command != NULL)
 193     {
 194       /* Initialize the string to blanks.  */
 195       if (command_len < 1)
 196         stat_flag = GFC_GC_FAILURE;
 197       else
 198         memset (command, ' ', command_len);
 199     }
 200
 201   for (i = 0; i < argc ; i++)
 202     {
 203       arglen = strlen(argv[i]);
 204
 205       if (command != NULL && stat_flag == GFC_GC_SUCCESS)
 206         {
 207           thisarg = arglen;
 208           if (tot_len + thisarg > command_len)
 209             {
 210               thisarg = command_len - tot_len; /* Truncate.  */
 211               stat_flag = GFC_GC_VALUE_TOO_SHORT;
 212             }
 213           /* Also a space before the next arg.  */
 214           else if (i != argc - 1 && tot_len + arglen == command_len)
 215             stat_flag = GFC_GC_VALUE_TOO_SHORT;
 216
 217           memcpy (&command[tot_len], argv[i], thisarg);
 218         }
 219
 220       /* Add the legth of the argument.  */
 221       tot_len += arglen;
 222       if (i != argc - 1)
 223         tot_len++;
 224     }
 225
 226   if (length != NULL)
 227     *length = tot_len;
 228
 229   if (status != NULL)
 230     *status = stat_flag;
 231 }
 232
 233
 234 /* INTEGER*8 wrapper for get_command.  */
 235
 236 void
 237 prefix(get_command_i8) (char *command,
 238                         GFC_INTEGER_8 *length,
 239                         GFC_INTEGER_8 *status,
 240                         gfc_charlen_type command_len)
 241 {
 242   GFC_INTEGER_4 length4;
 243   GFC_INTEGER_4 status4;
 244
 245   prefix (get_command_i4) (command, &length4, &status4, command_len);
 246   if (length)
 247     *length = length4;
 248   if (status)
 249     *status = status4;
 250 }