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.
6 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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.
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
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.
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. */
33 #include <sys/types.h>
35 #include "libgfortran.h"
38 /* Get a commandline argument. */
40 extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
41 iexport_proto(getarg_i4);
44 getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
50 get_args (&argc, &argv);
52 if (val_len < 1 || !val )
53 return; /* something is wrong , leave immediately */
55 memset (val, ' ', val_len);
57 if ((*pos) + 1 <= argc && *pos >=0 )
59 arglen = strlen (argv[*pos]);
62 memcpy (val, argv[*pos], arglen);
68 /* INTEGER*8 wrapper of getarg. */
70 extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
71 export_proto (getarg_i8);
74 getarg_i8 (GFC_INTEGER_8 *pos, char *val, gfc_charlen_type val_len)
76 GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
77 getarg_i4 (&pos4, val, val_len);
81 /* Return the number of commandline arguments. */
83 extern GFC_INTEGER_4 iargc (void);
92 get_args (&argc, &argv);
98 /* F2003 intrinsic functions and subroutines related to command line
101 - function command_argument_count() is converted to iargc by the compiler.
103 - subroutine get_command([command, length, status]).
105 - subroutine get_command_argument(number, [value, length, status]).
108 /* These two status codes are specified in the standard. */
109 #define GFC_GC_SUCCESS 0
110 #define GFC_GC_VALUE_TOO_SHORT -1
112 /* Processor-specific status failure code. */
113 #define GFC_GC_FAILURE 42
116 extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
117 GFC_INTEGER_4 *, gfc_charlen_type);
118 iexport_proto(get_command_argument_i4);
120 /* Get a single commandline argument. */
123 get_command_argument_i4 (GFC_INTEGER_4 *number, char *value,
124 GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
125 gfc_charlen_type value_len)
127 int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
131 /* Should never happen. */
132 runtime_error ("Missing argument to get_command_argument");
134 if (value == NULL && length == NULL && status == NULL)
135 return; /* No need to do anything. */
137 get_args (&argc, &argv);
139 if (*number < 0 || *number >= argc)
140 stat_flag = GFC_GC_FAILURE;
142 arglen = strlen(argv[*number]);
147 stat_flag = GFC_GC_FAILURE;
149 memset (value, ' ', value_len);
152 if (value != NULL && stat_flag != GFC_GC_FAILURE)
154 if (arglen > value_len)
157 stat_flag = GFC_GC_VALUE_TOO_SHORT;
159 memcpy (value, argv[*number], arglen);
168 iexport(get_command_argument_i4);
171 /* INTEGER*8 wrapper for get_command_argument. */
173 extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *,
174 GFC_INTEGER_8 *, gfc_charlen_type);
175 export_proto(get_command_argument_i8);
178 get_command_argument_i8 (GFC_INTEGER_8 *number, char *value,
179 GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
180 gfc_charlen_type value_len)
182 GFC_INTEGER_4 number4;
183 GFC_INTEGER_4 length4;
184 GFC_INTEGER_4 status4;
186 number4 = (GFC_INTEGER_4) *number;
187 get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
195 /* Return the whole commandline. */
197 extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
199 iexport_proto(get_command_i4);
202 get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
203 gfc_charlen_type command_len)
205 int i, argc, arglen, thisarg;
206 int stat_flag = GFC_GC_SUCCESS;
210 if (command == NULL && length == NULL && status == NULL)
211 return; /* No need to do anything. */
213 get_args (&argc, &argv);
217 /* Initialize the string to blanks. */
219 stat_flag = GFC_GC_FAILURE;
221 memset (command, ' ', command_len);
224 for (i = 0; i < argc ; i++)
226 arglen = strlen(argv[i]);
228 if (command != NULL && stat_flag == GFC_GC_SUCCESS)
231 if (tot_len + thisarg > command_len)
233 thisarg = command_len - tot_len; /* Truncate. */
234 stat_flag = GFC_GC_VALUE_TOO_SHORT;
236 /* Also a space before the next arg. */
237 else if (i != argc - 1 && tot_len + arglen == command_len)
238 stat_flag = GFC_GC_VALUE_TOO_SHORT;
240 memcpy (&command[tot_len], argv[i], thisarg);
243 /* Add the legth of the argument. */
255 iexport(get_command_i4);
258 /* INTEGER*8 wrapper for get_command. */
260 extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
262 export_proto(get_command_i8);
265 get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
266 gfc_charlen_type command_len)
268 GFC_INTEGER_4 length4;
269 GFC_INTEGER_4 status4;
271 get_command_i4 (command, &length4, &status4, command_len);