/*
* _fc_copy
*
* Arguments
* f The Fortran character descriptor
* sptr Pointer to the C character array.
* slen Length of the C character array.
*
* Returns:
* Pointer to sptr if successful. NULL otherwise.
*
* Copies the Fortran string described by Fortran character
* descriptor "f" to sptr and NULL-terminates it.
*
* If the string described by "f" contains a NULL character,
* that marks the end of the Fortran string. Trailing blanks
* are stripped before the string is copied.
*/
char *
_fc_copy(_fcd f, char *sptr, int slen)
{
int len;
char *start, *end;
#if defined(_UNICOS)
#if defined(_ADDR64)
if (_numargs() * sizeof(long) != (sizeof(_fcd) + sizeof(int) +
sizeof(char*)))
return(NULL);
#else
if (!_isfcd(f))
return(NULL);
#endif /* _ADDR64 */
#endif /* _UNICOS */
len = _fcdlen(f);
start = _fcdtocp(f);
/* see if string contains a NULL */
if ((end = memchr(start, '\0', len)) != NULL)
len = end - start;
/* remove trailing blanks */
while ((len > 0) && (start[len-1] == ' '))
len--;
if (len >= slen)
return(NULL); /* return NULL if too small */
(void) strncpy(sptr, start, len);
*(sptr + len) = '\0';
return(sptr);
}
/*
* _fc_acopy
*
* Returns:
* Pointer to a C string, if successful. NULL otherwise.
*
* Copies the Fortran string described by Fortran character
* descriptor "f" to an allocated, NULL-terminated C string. The
* string is allocated using malloc().
*
* If the string described by "f" contains a NULL character,
* that marks the end of the Fortran string. Trailing blanks
* are stripped before the string is copied.
*/
char *
_fc_acopy(_fcd f)
{
long len;
char *start, *end;
char *sptr;
#if defined(_UNICOS)
#if defined(_ADDR64)
if (_numargs() * sizeof(long) != sizeof(_fcd))
return(NULL);
#else
if (!_isfcd(f))
return(NULL);
#endif /* _ADDR64 */
#endif /* _UNICOS */
len = _fcdlen(f);
start = _fcdtocp(f);
/* see if string contains a NULL */
if ((end = memchr(start, '\0', len)) != NULL)
len = end - start;
/* remove trailing blanks */
while ((len > 0) && (start[len-1] == ' '))
len--;
/* allocate space */
if ((sptr = malloc(len+1)) == NULL)
return(NULL);
(void) strncpy(sptr, start, len);
*(sptr + len) = '\0';
return(sptr);
}
/*
* _clib_call - driver routine to call a utility routine or
* system call after translating one _fcd to
* a C character pointer.
*/
int
_clib_call(
int (*func)(),
_fcd arg1,
long arg2,
long arg3,
long arg4,
long arg5)
{
char *charptr;
int ret;
int num_syscall_args;
#ifndef _ADDR64
if (!_isfcd(arg1)) /* If not Fortran character */
charptr = *(char **)&arg1;
else
#endif
{
charptr = _f2ccpy(arg1);
if (charptr == NULL)
return(-1);
}
num_syscall_args = _numargs() - sizeof(_fcd)/sizeof(long);
switch( num_syscall_args ) {
case 1: ret = (*func)(charptr); break;
case 2: ret = (*func)(charptr,arg2); break;
case 3: ret = (*func)(charptr,arg2,arg3); break;
case 4: ret = (*func)(charptr,arg2,arg3,arg4); break;
case 5: ret = (*func)(charptr,arg2,arg3,arg4,arg5); break;
default: abort();
}
#ifndef _ADDR64
if (_isfcd(arg1))
#endif
free(charptr);
return(ret);
}
_f_int
ISHELL(_fcd cmdarg)
{
char *cptr;
int ret;
int fcdflag;
/* Check number of arguments */
if (_numargs() < 1)
return( (_f_int) -1);
/* IS cmdarg an _fcd ? */
fcdflag = 0;
#ifdef _ADDR64
if (_numargs() * sizeof(long) == sizeof(_fcd))
#else
if (_isfcd(cmdarg))
#endif
fcdflag = 1;
/* Convert argument to C character string */
if (fcdflag) { /* If Fortran character */
cptr = _fc_acopy(cmdarg);
if (cptr == NULL)
return( (_f_int) -1);
}
else
cptr = _fcdtocp(cmdarg);
/* Run command using system() */
ret = system(cptr);
if (ret == -1)
ret = -errno;
if (fcdflag)
free(cptr);
return( (_f_int) ret);
}
