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