]>
Commit | Line | Data |
---|---|---|
b41b2534 JB |
1 | /* Implementation of the GETARG and IARGC g77, and |
2 | corresponding F2003, intrinsics. | |
83ffe9cd | 3 | Copyright (C) 2004-2023 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 |
748086b7 | 11 | version 3 of the License, or (at your option) any later version. |
4aef80f8 BD |
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 | |
57dea9f6 | 16 | GNU General Public License for more details. |
4aef80f8 | 17 | |
748086b7 JJ |
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/>. */ | |
4aef80f8 | 26 | |
4aef80f8 | 27 | #include "libgfortran.h" |
36ae8a61 | 28 | #include <string.h> |
4aef80f8 | 29 | |
b41b2534 JB |
30 | |
31 | /* Get a commandline argument. */ | |
32 | ||
7d7b8bfe RH |
33 | extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type); |
34 | iexport_proto(getarg_i4); | |
35 | ||
4aef80f8 | 36 | void |
7d7b8bfe | 37 | getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len) |
4aef80f8 BD |
38 | { |
39 | int argc; | |
4aef80f8 BD |
40 | char **argv; |
41 | ||
42 | get_args (&argc, &argv); | |
43 | ||
44 | if (val_len < 1 || !val ) | |
45 | return; /* something is wrong , leave immediately */ | |
46 | ||
b41b2534 | 47 | memset (val, ' ', val_len); |
4aef80f8 BD |
48 | |
49 | if ((*pos) + 1 <= argc && *pos >=0 ) | |
50 | { | |
f622221a | 51 | gfc_charlen_type arglen = strlen (argv[*pos]); |
4aef80f8 BD |
52 | if (arglen > val_len) |
53 | arglen = val_len; | |
54 | memcpy (val, argv[*pos], arglen); | |
55 | } | |
56 | } | |
7d7b8bfe | 57 | iexport(getarg_i4); |
4aef80f8 | 58 | |
b41b2534 JB |
59 | |
60 | /* INTEGER*8 wrapper of getarg. */ | |
61 | ||
7d7b8bfe RH |
62 | extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type); |
63 | export_proto (getarg_i8); | |
64 | ||
b41b2534 | 65 | void |
7d7b8bfe | 66 | getarg_i8 (GFC_INTEGER_8 *pos, char *val, gfc_charlen_type val_len) |
b41b2534 | 67 | { |
7d7b8bfe RH |
68 | GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos; |
69 | getarg_i4 (&pos4, val, val_len); | |
b41b2534 JB |
70 | } |
71 | ||
72 | ||
5920b5d2 SK |
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. */ | |
b41b2534 | 76 | |
7d7b8bfe RH |
77 | extern GFC_INTEGER_4 iargc (void); |
78 | export_proto(iargc); | |
79 | ||
4aef80f8 | 80 | GFC_INTEGER_4 |
7d7b8bfe | 81 | iargc (void) |
4aef80f8 BD |
82 | { |
83 | int argc; | |
84 | char **argv; | |
85 | ||
86 | get_args (&argc, &argv); | |
87 | ||
5920b5d2 | 88 | return (argc - 1); |
4aef80f8 | 89 | } |
b41b2534 JB |
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 | ||
7d7b8bfe RH |
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 | ||
b41b2534 JB |
114 | /* Get a single commandline argument. */ |
115 | ||
116 | void | |
7d7b8bfe RH |
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) | |
b41b2534 | 120 | { |
f622221a JB |
121 | int argc, stat_flag = GFC_GC_SUCCESS; |
122 | gfc_charlen_type arglen = 0; | |
b41b2534 JB |
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) | |
b41b2534 | 150 | stat_flag = GFC_GC_VALUE_TOO_SHORT; |
e76e9231 TB |
151 | |
152 | memcpy (value, argv[*number], arglen <= value_len ? arglen : value_len); | |
b41b2534 JB |
153 | } |
154 | ||
155 | if (length != NULL) | |
156 | *length = arglen; | |
157 | ||
158 | if (status != NULL) | |
159 | *status = stat_flag; | |
160 | } | |
7d7b8bfe | 161 | iexport(get_command_argument_i4); |
b41b2534 JB |
162 | |
163 | ||
164 | /* INTEGER*8 wrapper for get_command_argument. */ | |
165 | ||
7d7b8bfe RH |
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 | ||
b41b2534 | 170 | void |
7d7b8bfe RH |
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) | |
b41b2534 JB |
174 | { |
175 | GFC_INTEGER_4 number4; | |
176 | GFC_INTEGER_4 length4; | |
177 | GFC_INTEGER_4 status4; | |
178 | ||
179 | number4 = (GFC_INTEGER_4) *number; | |
7d7b8bfe | 180 | get_command_argument_i4 (&number4, value, &length4, &status4, value_len); |
b41b2534 JB |
181 | if (length) |
182 | *length = length4; | |
183 | if (status) | |
184 | *status = status4; | |
185 | } | |
186 | ||
187 | ||
188 | /* Return the whole commandline. */ | |
189 | ||
7d7b8bfe RH |
190 | extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *, |
191 | gfc_charlen_type); | |
192 | iexport_proto(get_command_i4); | |
193 | ||
b41b2534 | 194 | void |
7d7b8bfe RH |
195 | get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, |
196 | gfc_charlen_type command_len) | |
b41b2534 | 197 | { |
f622221a | 198 | int i, argc, thisarg; |
b41b2534 | 199 | int stat_flag = GFC_GC_SUCCESS; |
b41b2534 | 200 | char **argv; |
f622221a | 201 | gfc_charlen_type arglen, tot_len = 0; |
b41b2534 JB |
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 | } | |
7d7b8bfe | 248 | iexport(get_command_i4); |
b41b2534 JB |
249 | |
250 | ||
251 | /* INTEGER*8 wrapper for get_command. */ | |
252 | ||
7d7b8bfe RH |
253 | extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *, |
254 | gfc_charlen_type); | |
255 | export_proto(get_command_i8); | |
256 | ||
b41b2534 | 257 | void |
7d7b8bfe RH |
258 | get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status, |
259 | gfc_charlen_type command_len) | |
b41b2534 JB |
260 | { |
261 | GFC_INTEGER_4 length4; | |
262 | GFC_INTEGER_4 status4; | |
263 | ||
7d7b8bfe | 264 | get_command_i4 (command, &length4, &status4, command_len); |
b41b2534 JB |
265 | if (length) |
266 | *length = length4; | |
267 | if (status) | |
268 | *status = status4; | |
269 | } |