#include "config.h"
#include <sys/types.h>
#include <string.h>
#include "libgfortran.h"
extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
iexport_proto(getarg_i4);
void
getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
{
int argc;
int arglen;
char **argv;
get_args (&argc, &argv);
if (val_len < 1 || !val )
return;
memset (val, ' ', val_len);
if ((*pos) + 1 <= argc && *pos >=0 )
{
arglen = strlen (argv[*pos]);
if (arglen > val_len)
arglen = val_len;
memcpy (val, argv[*pos], arglen);
}
}
iexport(getarg_i4);
extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
export_proto (getarg_i8);
void
getarg_i8 (GFC_INTEGER_8 *pos, char *val, gfc_charlen_type val_len)
{
GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
getarg_i4 (&pos4, val, val_len);
}
extern GFC_INTEGER_4 iargc (void);
export_proto(iargc);
GFC_INTEGER_4
iargc (void)
{
int argc;
char **argv;
get_args (&argc, &argv);
return (argc - 1);
}
#define GFC_GC_SUCCESS 0
#define GFC_GC_VALUE_TOO_SHORT -1
#define GFC_GC_FAILURE 42
extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
GFC_INTEGER_4 *, gfc_charlen_type);
iexport_proto(get_command_argument_i4);
void
get_command_argument_i4 (GFC_INTEGER_4 *number, char *value,
GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
gfc_charlen_type value_len)
{
int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
char **argv;
if (number == NULL )
runtime_error ("Missing argument to get_command_argument");
if (value == NULL && length == NULL && status == NULL)
return;
get_args (&argc, &argv);
if (*number < 0 || *number >= argc)
stat_flag = GFC_GC_FAILURE;
else
arglen = strlen(argv[*number]);
if (value != NULL)
{
if (value_len < 1)
stat_flag = GFC_GC_FAILURE;
else
memset (value, ' ', value_len);
}
if (value != NULL && stat_flag != GFC_GC_FAILURE)
{
if (arglen > value_len)
{
arglen = value_len;
stat_flag = GFC_GC_VALUE_TOO_SHORT;
}
memcpy (value, argv[*number], arglen);
}
if (length != NULL)
*length = arglen;
if (status != NULL)
*status = stat_flag;
}
iexport(get_command_argument_i4);
extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *,
GFC_INTEGER_8 *, gfc_charlen_type);
export_proto(get_command_argument_i8);
void
get_command_argument_i8 (GFC_INTEGER_8 *number, char *value,
GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
gfc_charlen_type value_len)
{
GFC_INTEGER_4 number4;
GFC_INTEGER_4 length4;
GFC_INTEGER_4 status4;
number4 = (GFC_INTEGER_4) *number;
get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
if (length)
*length = length4;
if (status)
*status = status4;
}
extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
gfc_charlen_type);
iexport_proto(get_command_i4);
void
get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
gfc_charlen_type command_len)
{
int i, argc, arglen, thisarg;
int stat_flag = GFC_GC_SUCCESS;
int tot_len = 0;
char **argv;
if (command == NULL && length == NULL && status == NULL)
return;
get_args (&argc, &argv);
if (command != NULL)
{
if (command_len < 1)
stat_flag = GFC_GC_FAILURE;
else
memset (command, ' ', command_len);
}
for (i = 0; i < argc ; i++)
{
arglen = strlen(argv[i]);
if (command != NULL && stat_flag == GFC_GC_SUCCESS)
{
thisarg = arglen;
if (tot_len + thisarg > command_len)
{
thisarg = command_len - tot_len;
stat_flag = GFC_GC_VALUE_TOO_SHORT;
}
else if (i != argc - 1 && tot_len + arglen == command_len)
stat_flag = GFC_GC_VALUE_TOO_SHORT;
memcpy (&command[tot_len], argv[i], thisarg);
}
tot_len += arglen;
if (i != argc - 1)
tot_len++;
}
if (length != NULL)
*length = tot_len;
if (status != NULL)
*status = stat_flag;
}
iexport(get_command_i4);
extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
gfc_charlen_type);
export_proto(get_command_i8);
void
get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
gfc_charlen_type command_len)
{
GFC_INTEGER_4 length4;
GFC_INTEGER_4 status4;
get_command_i4 (command, &length4, &status4, command_len);
if (length)
*length = length4;
if (status)
*status = status4;
}