1 /* Implementation of the GETARG and IARGC g77, and
2 corresponding F2003, intrinsics.
3 Copyright (C) 2004, 2005, 2007, 2009, 2010
4 Free Software Foundation, Inc.
5 Contributed by Bud Davis and Janne Blomqvist.
7 This file is part of the GNU Fortran 95 runtime library (libgfortran).
9 Libgfortran is free software; you can redistribute it and/or
10 modify it under the terms of the GNU General Public
11 License as published by the Free Software Foundation; either
12 version 3 of the License, or (at your option) any later version.
14 Libgfortran is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 Under Section 7 of GPL version 3, you are granted additional
20 permissions described in the GCC Runtime Library Exception, version
21 3.1, as published by the Free Software Foundation.
23 You should have received a copy of the GNU General Public License and
24 a copy of the GCC Runtime Library Exception along with this program;
25 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
26 <http://www.gnu.org/licenses/>. */
28 #include "libgfortran.h"
32 /* Get a commandline argument. */
34 extern void getarg_i4 (GFC_INTEGER_4
*, char *, gfc_charlen_type
);
35 iexport_proto(getarg_i4
);
38 getarg_i4 (GFC_INTEGER_4
*pos
, char *val
, gfc_charlen_type val_len
)
44 get_args (&argc
, &argv
);
46 if (val_len
< 1 || !val
)
47 return; /* something is wrong , leave immediately */
49 memset (val
, ' ', val_len
);
51 if ((*pos
) + 1 <= argc
&& *pos
>=0 )
53 arglen
= strlen (argv
[*pos
]);
56 memcpy (val
, argv
[*pos
], arglen
);
62 /* INTEGER*8 wrapper of getarg. */
64 extern void getarg_i8 (GFC_INTEGER_8
*, char *, gfc_charlen_type
);
65 export_proto (getarg_i8
);
68 getarg_i8 (GFC_INTEGER_8
*pos
, char *val
, gfc_charlen_type val_len
)
70 GFC_INTEGER_4 pos4
= (GFC_INTEGER_4
) *pos
;
71 getarg_i4 (&pos4
, val
, val_len
);
75 /* Return the number of commandline arguments. The g77 info page
76 states that iargc does not include the specification of the
77 program name itself. */
79 extern GFC_INTEGER_4
iargc (void);
88 get_args (&argc
, &argv
);
94 /* F2003 intrinsic functions and subroutines related to command line
97 - function command_argument_count() is converted to iargc by the compiler.
99 - subroutine get_command([command, length, status]).
101 - subroutine get_command_argument(number, [value, length, status]).
104 /* These two status codes are specified in the standard. */
105 #define GFC_GC_SUCCESS 0
106 #define GFC_GC_VALUE_TOO_SHORT -1
108 /* Processor-specific status failure code. */
109 #define GFC_GC_FAILURE 42
112 extern void get_command_argument_i4 (GFC_INTEGER_4
*, char *, GFC_INTEGER_4
*,
113 GFC_INTEGER_4
*, gfc_charlen_type
);
114 iexport_proto(get_command_argument_i4
);
116 /* Get a single commandline argument. */
119 get_command_argument_i4 (GFC_INTEGER_4
*number
, char *value
,
120 GFC_INTEGER_4
*length
, GFC_INTEGER_4
*status
,
121 gfc_charlen_type value_len
)
123 int argc
, arglen
= 0, stat_flag
= GFC_GC_SUCCESS
;
127 /* Should never happen. */
128 runtime_error ("Missing argument to get_command_argument");
130 if (value
== NULL
&& length
== NULL
&& status
== NULL
)
131 return; /* No need to do anything. */
133 get_args (&argc
, &argv
);
135 if (*number
< 0 || *number
>= argc
)
136 stat_flag
= GFC_GC_FAILURE
;
138 arglen
= strlen(argv
[*number
]);
143 stat_flag
= GFC_GC_FAILURE
;
145 memset (value
, ' ', value_len
);
148 if (value
!= NULL
&& stat_flag
!= GFC_GC_FAILURE
)
150 if (arglen
> value_len
)
151 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
153 memcpy (value
, argv
[*number
], arglen
<= value_len
? arglen
: value_len
);
162 iexport(get_command_argument_i4
);
165 /* INTEGER*8 wrapper for get_command_argument. */
167 extern void get_command_argument_i8 (GFC_INTEGER_8
*, char *, GFC_INTEGER_8
*,
168 GFC_INTEGER_8
*, gfc_charlen_type
);
169 export_proto(get_command_argument_i8
);
172 get_command_argument_i8 (GFC_INTEGER_8
*number
, char *value
,
173 GFC_INTEGER_8
*length
, GFC_INTEGER_8
*status
,
174 gfc_charlen_type value_len
)
176 GFC_INTEGER_4 number4
;
177 GFC_INTEGER_4 length4
;
178 GFC_INTEGER_4 status4
;
180 number4
= (GFC_INTEGER_4
) *number
;
181 get_command_argument_i4 (&number4
, value
, &length4
, &status4
, value_len
);
189 /* Return the whole commandline. */
191 extern void get_command_i4 (char *, GFC_INTEGER_4
*, GFC_INTEGER_4
*,
193 iexport_proto(get_command_i4
);
196 get_command_i4 (char *command
, GFC_INTEGER_4
*length
, GFC_INTEGER_4
*status
,
197 gfc_charlen_type command_len
)
199 int i
, argc
, arglen
, thisarg
;
200 int stat_flag
= GFC_GC_SUCCESS
;
204 if (command
== NULL
&& length
== NULL
&& status
== NULL
)
205 return; /* No need to do anything. */
207 get_args (&argc
, &argv
);
211 /* Initialize the string to blanks. */
213 stat_flag
= GFC_GC_FAILURE
;
215 memset (command
, ' ', command_len
);
218 for (i
= 0; i
< argc
; i
++)
220 arglen
= strlen(argv
[i
]);
222 if (command
!= NULL
&& stat_flag
== GFC_GC_SUCCESS
)
225 if (tot_len
+ thisarg
> command_len
)
227 thisarg
= command_len
- tot_len
; /* Truncate. */
228 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
230 /* Also a space before the next arg. */
231 else if (i
!= argc
- 1 && tot_len
+ arglen
== command_len
)
232 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
234 memcpy (&command
[tot_len
], argv
[i
], thisarg
);
237 /* Add the legth of the argument. */
249 iexport(get_command_i4
);
252 /* INTEGER*8 wrapper for get_command. */
254 extern void get_command_i8 (char *, GFC_INTEGER_8
*, GFC_INTEGER_8
*,
256 export_proto(get_command_i8
);
259 get_command_i8 (char *command
, GFC_INTEGER_8
*length
, GFC_INTEGER_8
*status
,
260 gfc_charlen_type command_len
)
262 GFC_INTEGER_4 length4
;
263 GFC_INTEGER_4 status4
;
265 get_command_i4 (command
, &length4
, &status4
, command_len
);