]>
Commit | Line | Data |
---|---|---|
b41b2534 JB |
1 | /* Implementation of the GETARG and IARGC g77, and |
2 | corresponding F2003, intrinsics. | |
4aef80f8 | 3 | Copyright (C) 2004 Free Software Foundation, Inc. |
b41b2534 | 4 | Contributed by Bud Davis and Janne Blomqvist. |
4aef80f8 BD |
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 | |
57dea9f6 | 9 | modify it under the terms of the GNU General Public |
4aef80f8 | 10 | License as published by the Free Software Foundation; either |
57dea9f6 TM |
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.) | |
4aef80f8 BD |
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 | |
57dea9f6 | 25 | GNU General Public License for more details. |
4aef80f8 | 26 | |
57dea9f6 TM |
27 | You should have received a copy of the GNU General Public |
28 | License along with libgfortran; see the file COPYING. If not, | |
4aef80f8 BD |
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 | ||
b41b2534 JB |
37 | |
38 | /* Get a commandline argument. */ | |
39 | ||
7d7b8bfe RH |
40 | extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type); |
41 | iexport_proto(getarg_i4); | |
42 | ||
4aef80f8 | 43 | void |
7d7b8bfe | 44 | getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len) |
4aef80f8 BD |
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 | ||
b41b2534 | 55 | memset (val, ' ', val_len); |
4aef80f8 BD |
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 | } | |
7d7b8bfe | 65 | iexport(getarg_i4); |
4aef80f8 | 66 | |
b41b2534 JB |
67 | |
68 | /* INTEGER*8 wrapper of getarg. */ | |
69 | ||
7d7b8bfe RH |
70 | extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type); |
71 | export_proto (getarg_i8); | |
72 | ||
b41b2534 | 73 | void |
7d7b8bfe | 74 | getarg_i8 (GFC_INTEGER_8 *pos, char *val, gfc_charlen_type val_len) |
b41b2534 | 75 | { |
7d7b8bfe RH |
76 | GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos; |
77 | getarg_i4 (&pos4, val, val_len); | |
b41b2534 JB |
78 | } |
79 | ||
80 | ||
81 | /* Return the number of commandline arguments. */ | |
82 | ||
7d7b8bfe RH |
83 | extern GFC_INTEGER_4 iargc (void); |
84 | export_proto(iargc); | |
85 | ||
4aef80f8 | 86 | GFC_INTEGER_4 |
7d7b8bfe | 87 | iargc (void) |
4aef80f8 BD |
88 | { |
89 | int argc; | |
90 | char **argv; | |
91 | ||
92 | get_args (&argc, &argv); | |
93 | ||
94 | return argc; | |
95 | } | |
b41b2534 JB |
96 | |
97 | ||
98 | /* F2003 intrinsic functions and subroutines related to command line | |
99 | arguments. | |
100 | ||
101 | - function command_argument_count() is converted to iargc by the compiler. | |
102 | ||
103 | - subroutine get_command([command, length, status]). | |
104 | ||
105 | - subroutine get_command_argument(number, [value, length, status]). | |
106 | */ | |
107 | ||
108 | /* These two status codes are specified in the standard. */ | |
109 | #define GFC_GC_SUCCESS 0 | |
110 | #define GFC_GC_VALUE_TOO_SHORT -1 | |
111 | ||
112 | /* Processor-specific status failure code. */ | |
113 | #define GFC_GC_FAILURE 42 | |
114 | ||
115 | ||
7d7b8bfe RH |
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); | |
119 | ||
b41b2534 JB |
120 | /* Get a single commandline argument. */ |
121 | ||
122 | void | |
7d7b8bfe RH |
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) | |
b41b2534 JB |
126 | { |
127 | int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS; | |
128 | char **argv; | |
129 | ||
130 | if (number == NULL ) | |
131 | /* Should never happen. */ | |
132 | runtime_error ("Missing argument to get_command_argument"); | |
133 | ||
134 | if (value == NULL && length == NULL && status == NULL) | |
135 | return; /* No need to do anything. */ | |
136 | ||
137 | get_args (&argc, &argv); | |
138 | ||
139 | if (*number < 0 || *number >= argc) | |
140 | stat_flag = GFC_GC_FAILURE; | |
141 | else | |
142 | arglen = strlen(argv[*number]); | |
143 | ||
144 | if (value != NULL) | |
145 | { | |
146 | if (value_len < 1) | |
147 | stat_flag = GFC_GC_FAILURE; | |
148 | else | |
149 | memset (value, ' ', value_len); | |
150 | } | |
151 | ||
152 | if (value != NULL && stat_flag != GFC_GC_FAILURE) | |
153 | { | |
154 | if (arglen > value_len) | |
155 | { | |
156 | arglen = value_len; | |
157 | stat_flag = GFC_GC_VALUE_TOO_SHORT; | |
158 | } | |
159 | memcpy (value, argv[*number], arglen); | |
160 | } | |
161 | ||
162 | if (length != NULL) | |
163 | *length = arglen; | |
164 | ||
165 | if (status != NULL) | |
166 | *status = stat_flag; | |
167 | } | |
7d7b8bfe | 168 | iexport(get_command_argument_i4); |
b41b2534 JB |
169 | |
170 | ||
171 | /* INTEGER*8 wrapper for get_command_argument. */ | |
172 | ||
7d7b8bfe RH |
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); | |
176 | ||
b41b2534 | 177 | void |
7d7b8bfe RH |
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) | |
b41b2534 JB |
181 | { |
182 | GFC_INTEGER_4 number4; | |
183 | GFC_INTEGER_4 length4; | |
184 | GFC_INTEGER_4 status4; | |
185 | ||
186 | number4 = (GFC_INTEGER_4) *number; | |
7d7b8bfe | 187 | get_command_argument_i4 (&number4, value, &length4, &status4, value_len); |
b41b2534 JB |
188 | if (length) |
189 | *length = length4; | |
190 | if (status) | |
191 | *status = status4; | |
192 | } | |
193 | ||
194 | ||
195 | /* Return the whole commandline. */ | |
196 | ||
7d7b8bfe RH |
197 | extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *, |
198 | gfc_charlen_type); | |
199 | iexport_proto(get_command_i4); | |
200 | ||
b41b2534 | 201 | void |
7d7b8bfe RH |
202 | get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, |
203 | gfc_charlen_type command_len) | |
b41b2534 JB |
204 | { |
205 | int i, argc, arglen, thisarg; | |
206 | int stat_flag = GFC_GC_SUCCESS; | |
207 | int tot_len = 0; | |
208 | char **argv; | |
209 | ||
210 | if (command == NULL && length == NULL && status == NULL) | |
211 | return; /* No need to do anything. */ | |
212 | ||
213 | get_args (&argc, &argv); | |
214 | ||
215 | if (command != NULL) | |
216 | { | |
217 | /* Initialize the string to blanks. */ | |
218 | if (command_len < 1) | |
219 | stat_flag = GFC_GC_FAILURE; | |
220 | else | |
221 | memset (command, ' ', command_len); | |
222 | } | |
223 | ||
224 | for (i = 0; i < argc ; i++) | |
225 | { | |
226 | arglen = strlen(argv[i]); | |
227 | ||
228 | if (command != NULL && stat_flag == GFC_GC_SUCCESS) | |
229 | { | |
230 | thisarg = arglen; | |
231 | if (tot_len + thisarg > command_len) | |
232 | { | |
233 | thisarg = command_len - tot_len; /* Truncate. */ | |
234 | stat_flag = GFC_GC_VALUE_TOO_SHORT; | |
235 | } | |
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; | |
239 | ||
240 | memcpy (&command[tot_len], argv[i], thisarg); | |
241 | } | |
242 | ||
243 | /* Add the legth of the argument. */ | |
244 | tot_len += arglen; | |
245 | if (i != argc - 1) | |
246 | tot_len++; | |
247 | } | |
248 | ||
249 | if (length != NULL) | |
250 | *length = tot_len; | |
251 | ||
252 | if (status != NULL) | |
253 | *status = stat_flag; | |
254 | } | |
7d7b8bfe | 255 | iexport(get_command_i4); |
b41b2534 JB |
256 | |
257 | ||
258 | /* INTEGER*8 wrapper for get_command. */ | |
259 | ||
7d7b8bfe RH |
260 | extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *, |
261 | gfc_charlen_type); | |
262 | export_proto(get_command_i8); | |
263 | ||
b41b2534 | 264 | void |
7d7b8bfe RH |
265 | get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status, |
266 | gfc_charlen_type command_len) | |
b41b2534 JB |
267 | { |
268 | GFC_INTEGER_4 length4; | |
269 | GFC_INTEGER_4 status4; | |
270 | ||
7d7b8bfe | 271 | get_command_i4 (command, &length4, &status4, command_len); |
b41b2534 JB |
272 | if (length) |
273 | *length = length4; | |
274 | if (status) | |
275 | *status = status4; | |
276 | } |