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