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 Lesser General Public
10 License as published by the Free Software Foundation; either
11 version 2.1 of the License, or (at your option) any later version.
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 Lesser General Public License for more details.
18 You should have received a copy of the GNU Lesser General Public
19 License along with libgfor; see the file COPYING.LIB. If not,
20 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
24 #include <sys/types.h>
26 #include "libgfortran.h"
29 /* Get a commandline argument. */
32 prefix(getarg_i4
) (GFC_INTEGER_4
*pos
, char *val
, gfc_charlen_type val_len
)
38 get_args (&argc
, &argv
);
40 if (val_len
< 1 || !val
)
41 return; /* something is wrong , leave immediately */
43 memset (val
, ' ', val_len
);
45 if ((*pos
) + 1 <= argc
&& *pos
>=0 )
47 arglen
= strlen (argv
[*pos
]);
50 memcpy (val
, argv
[*pos
], arglen
);
55 /* INTEGER*8 wrapper of getarg. */
58 prefix(getarg_i8
) (GFC_INTEGER_8
*pos
, char *val
, gfc_charlen_type val_len
)
62 pos4
= (GFC_INTEGER_4
) *pos
;
63 prefix(getarg_i4
) (&pos4
, val
, val_len
);
67 /* Return the number of commandline arguments. */
75 get_args (&argc
, &argv
);
81 /* F2003 intrinsic functions and subroutines related to command line
84 - function command_argument_count() is converted to iargc by the compiler.
86 - subroutine get_command([command, length, status]).
88 - subroutine get_command_argument(number, [value, length, status]).
91 /* These two status codes are specified in the standard. */
92 #define GFC_GC_SUCCESS 0
93 #define GFC_GC_VALUE_TOO_SHORT -1
95 /* Processor-specific status failure code. */
96 #define GFC_GC_FAILURE 42
99 /* Get a single commandline argument. */
102 prefix(get_command_argument_i4
) (GFC_INTEGER_4
*number
,
104 GFC_INTEGER_4
*length
,
105 GFC_INTEGER_4
*status
,
106 gfc_charlen_type value_len
)
108 int argc
, arglen
= 0, stat_flag
= GFC_GC_SUCCESS
;
112 /* Should never happen. */
113 runtime_error ("Missing argument to get_command_argument");
115 if (value
== NULL
&& length
== NULL
&& status
== NULL
)
116 return; /* No need to do anything. */
118 get_args (&argc
, &argv
);
120 if (*number
< 0 || *number
>= argc
)
121 stat_flag
= GFC_GC_FAILURE
;
123 arglen
= strlen(argv
[*number
]);
128 stat_flag
= GFC_GC_FAILURE
;
130 memset (value
, ' ', value_len
);
133 if (value
!= NULL
&& stat_flag
!= GFC_GC_FAILURE
)
135 if (arglen
> value_len
)
138 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
140 memcpy (value
, argv
[*number
], arglen
);
151 /* INTEGER*8 wrapper for get_command_argument. */
154 prefix(get_command_argument_i8
) (GFC_INTEGER_8
*number
,
156 GFC_INTEGER_8
*length
,
157 GFC_INTEGER_8
*status
,
158 gfc_charlen_type value_len
)
160 GFC_INTEGER_4 number4
;
161 GFC_INTEGER_4 length4
;
162 GFC_INTEGER_4 status4
;
164 number4
= (GFC_INTEGER_4
) *number
;
165 prefix (get_command_argument_i4
) (&number4
, value
, &length4
, &status4
,
174 /* Return the whole commandline. */
177 prefix(get_command_i4
) (char *command
,
178 GFC_INTEGER_4
*length
,
179 GFC_INTEGER_4
*status
,
180 gfc_charlen_type command_len
)
182 int i
, argc
, arglen
, thisarg
;
183 int stat_flag
= GFC_GC_SUCCESS
;
187 if (command
== NULL
&& length
== NULL
&& status
== NULL
)
188 return; /* No need to do anything. */
190 get_args (&argc
, &argv
);
194 /* Initialize the string to blanks. */
196 stat_flag
= GFC_GC_FAILURE
;
198 memset (command
, ' ', command_len
);
201 for (i
= 0; i
< argc
; i
++)
203 arglen
= strlen(argv
[i
]);
205 if (command
!= NULL
&& stat_flag
== GFC_GC_SUCCESS
)
208 if (tot_len
+ thisarg
> command_len
)
210 thisarg
= command_len
- tot_len
; /* Truncate. */
211 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
213 /* Also a space before the next arg. */
214 else if (i
!= argc
- 1 && tot_len
+ arglen
== command_len
)
215 stat_flag
= GFC_GC_VALUE_TOO_SHORT
;
217 memcpy (&command
[tot_len
], argv
[i
], thisarg
);
220 /* Add the legth of the argument. */
234 /* INTEGER*8 wrapper for get_command. */
237 prefix(get_command_i8
) (char *command
,
238 GFC_INTEGER_8
*length
,
239 GFC_INTEGER_8
*status
,
240 gfc_charlen_type command_len
)
242 GFC_INTEGER_4 length4
;
243 GFC_INTEGER_4 status4
;
245 prefix (get_command_i4
) (command
, &length4
, &status4
, command_len
);