Skip to content
Permalink
Browse files

Implement Fortran 2018 EXECUTE_COMMAND_LINE

  • Loading branch information...
gklimowicz committed Nov 5, 2019
1 parent eab3991 commit 0a1e691e028ffe3c64eb28a86b1dc68ae9e285d2
@@ -1,5 +1,5 @@
/*
* Copyright (c) 1995-2018, NVIDIA CORPORATION. All rights reserved.
* Copyright (c) 1995-2019, NVIDIA CORPORATION. All rights reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -24,12 +24,20 @@
#include "stdioInterf.h"
#include "fioMacros.h"

extern char *__fstr2cstr();

void
ENTFTN(TEMPLATE, template)(F90_Desc *dd, __INT_T *p_rank,
__INT_T *p_flags, ...);

#include <string.h>
#include "fort_vars.h"

#if defined(TARGET_LINUX_X8664) || defined (TARGET_LINUX_POWER) || defined(TARGET_OSX_X8664)
#include <unistd.h>
#include <sys/wait.h>
#endif
static void store_int_kind(void *, __INT_T *, int);
static void ftn_msgcpy(char*, const char*, int);
static char *intents[] = {"INOUT", "IN", "OUT", "??"};

/** \brief Compare alignments and local storage sequences. Return true if all
@@ -2808,4 +2816,163 @@ ENTF90(CONTIGCHK, contigchk)(void *ptr, F90_Desc *pd, __INT_T lineno,
ENTF90(CONTIGERROR, contigerror)(ptr, pd, lineno, ptrnam, srcfil, flags);
}
}

/** \brief Execute a command line.
*
* \param command is the command to be executed.
* \param wait controls to execute command synchronously or asynchronously.
* \param exitstatus is the value of exit status.
* \param cmdstat shows the status of command execution.
* \param cmdmsg is the assigned explanatory message.
* \param exitstat_int_kind is the integer kind for the exitstat.
* \param cmdstat_int_kind is the integer kind for the cmdstat.
* \param DCLEN64(command) is generated by compiler which contains the length
* of the command string.
* \param DCLEN64(cmdmsg) is generated by compiler which contains the length
of the cmdmsg string.
*/
void
ENTF90(EXECCMDLINE, execcmdline)(DCHAR(command), __LOG_T *wait,
__INT_T *exitstatus,
__INT_T *cmdstat, DCHAR (cmdmsg),
__INT_T *exitstat_int_kind,
__INT_T *cmdstat_int_kind
DCLEN64(command) DCLEN64(cmdmsg)) {
char *cmd, *cmdmes;
int cmdmes_len, stat;
int cmdflag = 0;
enum CMD_ERR{NO_SUPPORT_ERR=-1, FORK_ERR=1, EXECL_ERR=2, SIGNAL_ERR=3};

cmd = __fstr2cstr(CADR(command), CLEN(command));
cmdmes = (char*) CADR(cmdmsg);
cmdmes_len = CLEN(cmdmsg);

if (cmdstat)
store_int_kind(cmdstat, cmdstat_int_kind, 0);
#if defined(TARGET_LINUX_X8664) || defined(TARGET_OSX_X8664) || defined (TARGET_LINUX_POWER)
pid_t pid, w;
int wstatus, ret;

/* If WAIT is present with the value false, and the processor supports
* asynchronous execution of the command, the command is executed
* asynchronously; otherwise it is executed synchronously.
*/
pid = fork();
if (pid < 0) {
if (cmdmes)
ftn_msgcpy(cmdmes, "Fork failed", cmdmsg_len);
if (cmdstat)
store_int_kind(cmdstat, cmdstat_int_kind, FORK_ERR);
} else if (pid == 0) {
ret = execl("/bin/sh", "sh", "-c", cmd, (char *) NULL);
exit(ret);
} else {
// either wait is not specified or wait is true, then synchronous mode
if ( !wait || *wait == -1) {
#if DEBUG
printf("either wait is not specified or Wait = .true.\n");
printf("Synchronous execution mode!\n");
#endif
/* code executed by parent, wait for children */
w = waitpid(pid, &wstatus, WUNTRACED | WCONTINUED);
if (w == -1)
cmdflag = EXECL_ERR;

if (WIFEXITED(wstatus)) {
stat = WEXITSTATUS(wstatus);

if (exitstatus)
store_int_kind(exitstatus, exitstat_int_kind, stat);
}

if (WIFSIGNALED(wstatus))
cmdflag = SIGNAL_ERR;

if (cmdstat && cmdflag > 0)
store_int_kind(cmdstat, cmdstat_int_kind, cmdflag);

if (cmdmes) {
switch (cmdflag) {
case EXECL_ERR:
ftn_msgcpy(cmdmes, "Excel failed", cmdmsg_len);
break;
case SIGNAL_ERR:
ftn_msgcpy(cmdmes, "Signal error", cmdmsg_len);
break;
}
}

/* If a condition occurs that would assign a nonzero value to CMDSTAT
but the CMDSTAT variable is not present, error termination is
initiated.
*/
if (!cmdstat && cmdflag > 0) {
fprintf(__io_stderr(), "ERROR STOP ");
exit(cmdflag);
}

#if DEBUG
if (WIFEXITED(wstatus)) {
printf("exited, status=%d\n", WEXITSTATUS(wstatus));
} else if (WIFSIGNALED(wstatus)) {
printf("killed by signal %d\n", WTERMSIG(wstatus));
} else if (WIFSTOPPED(wstatus)) {
printf("stopped by signal %d\n", WSTOPSIG(wstatus));
} else if (WIFCONTINUED(wstatus)) {
printf("continued\n");
}
#endif
} // end else
}
#else // defined(TARGET_WIN)
// Windows runtime work to be continued.
cmdflag = NO_SUPPORT_ERR;
if (cmdmes)
ftn_msgcpy(cmdmes, "No Windows support", cmdmsg_len);
if (cmdstat)
store_int_kind(cmdstat, cmdstat_int_kind, cmdflag);
else
__fort_abort("execute_command_line: not yet supported on Windows\n");
#endif
__cstr_free(cmd);
}

// TODO: Code restructure needed to reduce redundant codes.
/*
* helper function to store an int/logical value into a varying int/logical
*/
static void
store_int_kind(void *b, __INT_T *int_kind, int v)
{
switch (*int_kind) {
case 1:
*(__INT1_T *)b = (__INT1_T)v;
break;
case 2:
*(__INT2_T *)b = (__INT2_T)v;
break;
case 4:
*(__INT4_T *)b = (__INT4_T)v;
break;
case 8:
*(__INT8_T *)b = (__INT8_T)v;
break;
default:
__fort_abort("store_int_kind: unexpected int kind");
}
}

// TODO: Code restructure needed to reduce redundant codes.
/** \brief Copy msg string to statmsg and padding with blank space at the end.
*
* \param statmsg is the Fortran string we want to assign values.
* \param msg is the string contains error message.
* \param len is the length of statmsg.
*/
static void
ftn_msgcpy(char *statmsg, const char *msg, int len) {
int i;
for (i=0; i<len; ++i) {
statmsg[i] = *msg ? *msg++ : ' ';
}
}
@@ -1968,6 +1968,23 @@ rewrite_func_ast(int func_ast, int func_args, int lhs)
ARGT_ARG(newargt, 3) = dim;
}
goto ret_new;
case I_EXECUTE_COMMAND_LINE:
nargs = 7;
rtlRtn = RTE_execcmdline;
newsym = sym_mkfunc_nodesc(mkRteRtnNm(rtlRtn), DT_INT);
newargt = mk_argt(nargs);
for (i = 0; i < nargs - 1; i++) {
int arg = ARGT_ARG(func_args, i);
ARGT_ARG(newargt, i) = arg != 0 ? arg : i == 0 ? astb.ptr0c : astb.ptr0;
}
/* Add two extra arguments at the end of the execute_command_line argument
list. Those two integer kind for the exitstat and cmdstat argument
respectively.
*/
ARGT_ARG(newargt, nargs - 2) = mk_cval(size_of(stb.user.dt_int), DT_INT4);
ARGT_ARG(newargt, nargs - 1) = mk_cval(size_of(stb.user.dt_int), DT_INT4);
is_icall = FALSE;
goto ret_call;
case I_NORM2: /* norm2(array, [dim]) */
srcarray = ARGT_ARG(func_args, 0);
dim = ARGT_ARG(func_args, 1);
@@ -11535,6 +11535,76 @@ ref_pd_subr(SST *stktop, ITEM *list)
argt_count = 4;
break;

case PD_execute_command_line:
if (count < 1 || count > 5) {
E74_CNT(pdsym, count, 1, 5);
goto call_e74_cnt;
}
if (get_kwd_args(list, 5, KWDARGSTR(pdsym)))
goto exit_;
sp = ARG_STK(0);

if ((sp = ARG_STK(0))) { /* command */
(void)mkarg(sp, &dum);
XFR_ARGAST(0);
dtype2 = SST_DTYPEG(sp);
if (DTY(dtype2) != TY_CHAR) {
E74_ARG(pdsym, 0, NULL);
goto call_e74_arg;
}
}

if ((sp = ARG_STK(1))) { /* wait */
(void)mkexpr(sp);
XFR_ARGAST(1);
dtype2 = SST_DTYPEG(sp);
if (dtype2 != stb.user.dt_log) {
E74_ARG(pdsym, 1, NULL);
goto call_e74_arg;
}
}
if ((sp = ARG_STK(2))) { /* exitstatus */
if (!is_varref(sp)) {
E74_ARG(pdsym, 2, NULL);
goto call_e74_arg;
}
(void)mkarg(sp, &dum);
XFR_ARGAST(2);
dtype2 = SST_DTYPEG(sp);
if (dtype2 != stb.user.dt_int) {
E74_ARG(pdsym, 2, NULL);
goto call_e74_arg;
}
}
if ((sp = ARG_STK(3))) { /* cmdstat */
if (!is_varref(sp)) {
E74_ARG(pdsym, 3, NULL);
goto call_e74_arg;
}
(void)mkarg(sp, &dum);
XFR_ARGAST(3);
dtype2 = SST_DTYPEG(sp);
if (dtype2 != stb.user.dt_int) {
E74_ARG(pdsym, 3, NULL);
goto call_e74_arg;
}
}
if ((sp = ARG_STK(4))) { /* cmdmsg */
if (!is_varref(sp)) {
E74_ARG(pdsym, 4, NULL);
goto call_e74_arg;
}
(void)mkarg(sp, &dum);
XFR_ARGAST(4);
dtype2 = SST_DTYPEG(sp);
if (DTY(dtype2) != TY_CHAR) {
E74_ARG(pdsym, 4, NULL);
goto call_e74_arg;
}
}
argt_count = 5;
break;

case PD_get_command:
if (count > 3) {
E74_CNT(pdsym, count, 0, 3);
@@ -1900,7 +1900,7 @@ sptr name pcnt atyp dtype ILM pname arrayf native?
.AT transformational x *dim
.H7 .PARITY - -
.AT transformational mask *dim
.H7 .EXECUTE_COMMAND_LINE - -
.H7 EXECUTE_COMMAND_LINE - -
.AT subroutine command *wait *exitstat *cmdstat *cmdmsg
.H7 FINDLOC - -
.AT transformational array value *dim *mask *kind *back
@@ -116,6 +116,7 @@ FtnRteRtn ftnRtlRtns[] = {
{"dmodulov", "", false, ""},
{"errorstop08a_char", "", false, ""},
{"errorstop08a_int", "", false, ""},
{"execcmdline", "", false, ""},
{"exit", "", false, ""},
{"expon", "", false, "k"},
{"expond", "", false, "k"},
@@ -121,6 +121,7 @@ typedef enum {
RTE_dmodulov,
RTE_errorstop08a_char,
RTE_errorstop08a_int,
RTE_execcmdline,
RTE_exit,
RTE_expon,
RTE_expond,

0 comments on commit 0a1e691

Please sign in to comment.
You can’t perform that action at this time.