void sexp_usage(int err) {
printf("usage: chibi-scheme [<options> ...] [<file> <args> ...]\n"
#if SEXP_USE_FOLD_CASE_SYMS
" -f - case-fold symbols\n"
#endif
" -q - \"quick\" load, use the core -xchibi language\n"
" -Q - extra \"quick\" load, -xchibi.primitive\n"
" -V - print version information\n"
" -D <feature> - add <feature> to the list of features\n"
#if ! SEXP_USE_BOEHM
" -h <size> - specify the initial heap size\n"
#endif
#if SEXP_USE_MODULES
" -A <dir> - append a module search directory\n"
" -I <dir> - prepend a module search directory\n"
" -m <module> - import a module\n"
" -x <module> - import only a module\n"
#endif
" -e <expr> - evaluate an expression\n"
" -p <expr> - evaluate and print an expression\n"
" -r[<main>] - run a SRFI-22 main\n"
" -R[<module>] - run main from a module\n"
" -t <module.proc> - trace a procedure\n"
" -T - disable TCO (dangerous)\n"
#if SEXP_USE_IMAGE_LOADING
" -d <file> - dump an image file and exit\n"
" -i <file> - load an image file\n"
#endif
);
if (err == 0) exit_success();
else exit_failure();
}
int main (int argc, char **argv) {
#if SEXP_USE_PRINT_BACKTRACE_ON_SEGFAULT
signal(SIGSEGV, sexp_segfault_handler);
#endif
sexp_scheme_init();
run_main(argc, argv);
exit_success();
return 0;
}
int main (int argc, char **argv) {
#if SEXP_USE_PRINT_BACKTRACE_ON_SEGFAULT
signal(SIGSEGV, sexp_segfault_handler);
#endif
sexp_scheme_init();
if (run_main(argc, argv) == SEXP_FALSE) {
exit_failure();
} else {
exit_success();
}
return 0;
}
/* parent will terminate if child dies. */
static void
sig_child(int sig __unused)
{
int status;
pid_t pid;
pid = wait3(&status, WNOHANG, (struct rusage *)0);
if (pid > 0 && WEXITSTATUS(status))
syslog(LOG_WARNING, "child %ld exit status 0x%x",
(long)pid, status);
exit_success("terminate connection due to child termination");
}
/* parent will terminate if child dies. */
static void
sig_child(int sig)
{
struct syslog_data sdata = SYSLOG_DATA_INIT;
int status;
pid_t pid;
pid = wait3(&status, WNOHANG, (struct rusage *)0);
if (pid > 0 && WEXITSTATUS(status))
syslog_r(LOG_WARNING, &sdata,
"child %ld exit status 0x%x", (long)pid, status);
exit_success("terminate connection due to child termination");
}
static void
relay(int src, int dst)
{
int error;
ssize_t n;
int atmark;
error = ioctl(s_rcv, SIOCATMARK, &atmark);
if (error != -1 && atmark == 1) {
n = read(s_rcv, rshbuf, 1);
if (n == 1)
send(s_snd, rshbuf, 1, MSG_OOB);
return;
}
n = read(s_rcv, rshbuf, sizeof(rshbuf));
switch (n) {
case -1:
exit_failure("%s", strerror(errno));
case 0:
if (s_rcv == src) {
/* half close */
shutdown(dst, 1);
half = YES;
break;
}
close(src);
close(dst);
close(s_ctl);
close(s_ctl6);
exit_success("terminating rsh/contorol connections");
break;
default:
write(s_snd, rshbuf, n);
}
}
void
ftp_relay(int ctl6, int ctl4)
{
#ifdef HAVE_POLL_H
struct pollfd pfd[6];
#else
fd_set readfds;
#endif
int error;
enum state state = NONE;
struct timeval tv;
syslog(LOG_INFO, "starting ftp control connection");
for (;;) {
#ifdef HAVE_POLL_H
pfd[0].fd = ctl4;
pfd[0].events = POLLIN;
pfd[1].fd = ctl6;
pfd[1].events = POLLIN;
if (0 <= port4) {
pfd[2].fd = port4;
pfd[2].events = POLLIN;
} else
pfd[2].fd = -1;
if (0 <= port6) {
pfd[3].fd = port6;
pfd[3].events = POLLIN;
} else
pfd[3].fd = -1;
#if 0
if (0 <= wport4) {
pfd[4].fd = wport4;
pfd[4].events = POLLIN;
} else
pfd[4].fd = -1;
if (0 <= wport6) {
pfd[5].fd = wport4;
pfd[5].events = POLLIN;
} else
pfd[5].fd = -1;
#else
pfd[4].fd = pfd[5].fd = -1;
pfd[4].events = pfd[5].events = 0;
#endif
#else
int maxfd = 0;
FD_ZERO(&readfds);
if (ctl4 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(ctl4, &readfds);
maxfd = ctl4;
if (ctl6 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(ctl6, &readfds);
maxfd = (ctl6 > maxfd) ? ctl6 : maxfd;
if (0 <= port4) {
if (port4 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(port4, &readfds);
maxfd = (port4 > maxfd) ? port4 : maxfd;
}
if (0 <= port6) {
if (port6 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(port6, &readfds);
maxfd = (port6 > maxfd) ? port6 : maxfd;
}
#if 0
if (0 <= wport4) {
if (wport4 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(wport4, &readfds);
maxfd = (wport4 > maxfd) ? wport4 : maxfd;
}
if (0 <= wport6) {
if (wport6 >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(wport6, &readfds);
maxfd = (wport6 > maxfd) ? wport6 : maxfd;
}
#endif
#endif
tv.tv_sec = FAITH_TIMEOUT;
tv.tv_usec = 0;
#ifdef HAVE_POLL_H
error = poll(pfd, sizeof(pfd)/sizeof(pfd[0]), tv.tv_sec * 1000);
#else
error = select(maxfd + 1, &readfds, NULL, NULL, &tv);
#endif
if (error == -1) {
#ifdef HAVE_POLL_H
exit_failure("poll: %s", strerror(errno));
#else
exit_failure("select: %s", strerror(errno));
#endif
}
else if (error == 0)
exit_failure("connection timeout");
/*
* The order of the following checks does (slightly) matter.
* It is important to visit all checks (do not use "continue"),
* otherwise some of the pipe may become full and we cannot
* relay correctly.
*/
#ifdef HAVE_POLL_H
if (pfd[1].revents & POLLIN)
#else
if (FD_ISSET(ctl6, &readfds))
#endif
{
/*
* copy control connection from the client.
* command translation is necessary.
*/
error = ftp_copycommand(ctl6, ctl4, &state);
if (error < 0)
goto bad;
else if (error == 0) {
close(ctl4);
close(ctl6);
exit_success("terminating ftp control connection");
/*NOTREACHED*/
}
}
#ifdef HAVE_POLL_H
if (pfd[0].revents & POLLIN)
#else
if (FD_ISSET(ctl4, &readfds))
#endif
{
/*
* copy control connection from the server
* translation of result code is necessary.
*/
error = ftp_copyresult(ctl4, ctl6, state);
if (error < 0)
goto bad;
else if (error == 0) {
close(ctl4);
close(ctl6);
exit_success("terminating ftp control connection");
/*NOTREACHED*/
}
}
#ifdef HAVE_POLL_H
if (0 <= port4 && 0 <= port6 && (pfd[2].revents & POLLIN))
#else
if (0 <= port4 && 0 <= port6 && FD_ISSET(port4, &readfds))
#endif
{
/*
* copy data connection.
* no special treatment necessary.
*/
#ifdef HAVE_POLL_H
if (pfd[2].revents & POLLIN)
#else
if (FD_ISSET(port4, &readfds))
#endif
error = ftp_copy(port4, port6);
switch (error) {
case -1:
goto bad;
case 0:
close(port4);
close(port6);
port4 = port6 = -1;
syslog(LOG_INFO, "terminating data connection");
break;
default:
break;
}
}
#ifdef HAVE_POLL_H
if (0 <= port4 && 0 <= port6 && (pfd[3].revents & POLLIN))
#else
if (0 <= port4 && 0 <= port6 && FD_ISSET(port6, &readfds))
#endif
{
/*
* copy data connection.
* no special treatment necessary.
*/
#ifdef HAVE_POLL_H
if (pfd[3].revents & POLLIN)
#else
if (FD_ISSET(port6, &readfds))
#endif
error = ftp_copy(port6, port4);
switch (error) {
case -1:
goto bad;
case 0:
close(port4);
close(port6);
port4 = port6 = -1;
syslog(LOG_INFO, "terminating data connection");
break;
default:
break;
}
}
#if 0
#ifdef HAVE_POLL_H
if (wport4 && (pfd[4].revents & POLLIN))
#else
if (wport4 && FD_ISSET(wport4, &readfds))
#endif
{
/*
* establish active data connection from the server.
*/
ftp_activeconn();
}
#ifdef HAVE_POLL_H
if (wport4 && (pfd[5].revents & POLLIN))
#else
if (wport6 && FD_ISSET(wport6, &readfds))
#endif
{
/*
* establish passive data connection from the client.
*/
ftp_passiveconn();
}
#endif
}
bad:
exit_failure("%s", strerror(errno));
}
static void
relay(int s_rcv, int s_snd, const char *service, int direction)
{
int atmark, error, maxfd;
struct timeval tv;
fd_set oreadfds, owritefds, oexceptfds;
FD_ZERO(&readfds);
FD_ZERO(&writefds);
FD_ZERO(&exceptfds);
fcntl(s_snd, F_SETFD, O_NONBLOCK);
oreadfds = readfds; owritefds = writefds; oexceptfds = exceptfds;
if (s_rcv >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(s_rcv, &readfds);
FD_SET(s_rcv, &exceptfds);
oob_exists = 0;
maxfd = (s_rcv > s_snd) ? s_rcv : s_snd;
for (;;) {
tv.tv_sec = FAITH_TIMEOUT / 4;
tv.tv_usec = 0;
oreadfds = readfds;
owritefds = writefds;
oexceptfds = exceptfds;
error = select(maxfd + 1, &readfds, &writefds, &exceptfds, &tv);
if (error == -1) {
if (errno == EINTR)
continue;
exit_failure("select: %s", strerror(errno));
} else if (error == 0) {
readfds = oreadfds;
writefds = owritefds;
exceptfds = oexceptfds;
notify_inactive();
continue;
}
/* activity notification */
notify_active();
if (FD_ISSET(s_rcv, &exceptfds)) {
error = ioctl(s_rcv, SIOCATMARK, &atmark);
if (error != -1 && atmark == 1) {
int cc;
oob_read_retry:
cc = read(s_rcv, atmark_buf, 1);
if (cc == 1) {
if (s_rcv >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_CLR(s_rcv, &exceptfds);
if (s_snd >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(s_snd, &writefds);
oob_exists = 1;
} else if (cc == -1) {
if (errno == EINTR)
goto oob_read_retry;
exit_failure("reading oob data failed"
": %s",
strerror(errno));
}
}
}
if (FD_ISSET(s_rcv, &readfds)) {
relaydata_read_retry:
tblen = read(s_rcv, tcpbuf, sizeof(tcpbuf));
tboff = 0;
switch (tblen) {
case -1:
if (errno == EINTR)
goto relaydata_read_retry;
exit_failure("reading relay data failed: %s",
strerror(errno));
/* NOTREACHED */
case 0:
/* to close opposite-direction relay process */
shutdown(s_snd, 0);
close(s_rcv);
close(s_snd);
exit_success("terminating %s relay", service);
/* NOTREACHED */
default:
if (s_rcv >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_CLR(s_rcv, &readfds);
if (s_snd >= FD_SETSIZE)
exit_failure("descriptor too big");
FD_SET(s_snd, &writefds);
break;
}
}
if (FD_ISSET(s_snd, &writefds))
send_data(s_rcv, s_snd, service, direction);
}
}
int main(int argc, char **argv)
{
unsigned long long ramsizeGB = 1;
char *end;
int ch;
int opt_ind = 0;
const char *sopt = "hr:c:";
struct option lopt[] = {
{ "help", no_argument, NULL, 'h' },
{ "ramsize", required_argument, NULL, 'r' },
{ "cpus", required_argument, NULL, 'c' },
{ NULL, 0, NULL, 0 }
};
int ret;
int ncpus = 0;
argv0 = argv[0];
while ((ch = getopt_long(argc, argv, sopt, lopt, &opt_ind)) != -1) {
switch (ch) {
case 'r':
errno = 0;
ramsizeGB = strtoll(optarg, &end, 10);
if (errno != 0 || *end) {
fprintf(stderr, "%s (%05d): ERROR: Cannot parse RAM size %s\n",
argv0, gettid(), optarg);
exit_failure();
}
break;
case 'c':
errno = 0;
ncpus = strtoll(optarg, &end, 10);
if (errno != 0 || *end) {
fprintf(stderr, "%s (%05d): ERROR: Cannot parse CPU count %s\n",
argv0, gettid(), optarg);
exit_failure();
}
break;
case '?':
case 'h':
fprintf(stderr, "%s: [--help][--ramsize GB][--cpus N]\n", argv0);
exit_failure();
}
}
if (getpid() == 1) {
if (mount_all() < 0)
exit_failure();
ret = get_command_arg_ull("ramsize", &ramsizeGB);
if (ret < 0)
exit_failure();
}
if (ncpus == 0)
ncpus = sysconf(_SC_NPROCESSORS_ONLN);
fprintf(stdout, "%s (%05d): INFO: RAM %llu GiB across %d CPUs\n",
argv0, gettid(), ramsizeGB, ncpus);
if (stress(ramsizeGB, ncpus) < 0)
exit_failure();
exit_success();
}
/* parse_options: Parses command line options and sets global variables. */
static int parse_options(int argc, char **argv)
{
int opt, checktimer = 0;
while ( (opt = getopt(argc, argv, "apchqTgx:X:r:R:s:S:e:E:l:t:w:z:mv")) != -1) {
switch (opt) {
case 'a':
mpiperf_statanalysis = 0;
break;
case 'c':
mpiperf_isflushcache = 1;
break;
case 'x':
mpiperf_param_min = parse_intval(optarg);
break;
case 'X':
mpiperf_param_max = parse_intval(optarg);
break;
case 'e':
mpiperf_test_exit_cond = TEST_EXIT_COND_STDERR;
mpiperf_rse_max = atoi(optarg) / 100.0;
if (mpiperf_rse_max < 1E-3) {
if (IS_MASTER_RANK) {
exit_error("Incorrect value of RSE (-e)");
}
}
break;
case 'E':
mpiperf_test_exit_cond = TEST_EXIT_COND_NRUNS;
mpiperf_nmeasures_max = atoi(optarg);
if (mpiperf_nmeasures_max < 1) {
exit_error("Incorrect value of number of measurements (-E)");
}
break;
case 'r':
mpiperf_nruns_min = atoi(optarg);
if (mpiperf_nruns_min < 1) {
exit_error("Incorrect value of minimal number of runs (-r)");
}
break;
case 'R':
mpiperf_nruns_max = atoi(optarg);
if (mpiperf_nruns_max < 1 || mpiperf_nruns_max < mpiperf_nruns_min) {
exit_error("Incorrect value of maximal number of runs (-R)");
}
break;
case 's':
mpiperf_param_step = atoi(optarg);
mpiperf_param_step_type = PARAM_STEP_INC;
break;
case 'S':
mpiperf_param_step = atoi(optarg);
mpiperf_param_step_type = PARAM_STEP_MUL;
break;
case 'p':
mpiperf_genprocreport = 1;
break;
case 'l':
mpiperf_logfile = optarg;
break;
case 'z':
if (strcasecmp(optarg, "synctime") == 0) {
mpiperf_synctype = MPIPERF_SYNC_TIME;
} else if (strcasecmp(optarg, "nosync") == 0) {
mpiperf_synctype = MPIPERF_SYNC_NONE;
} else {
exit_error("Unknown synchronization method: %s", optarg);
}
break;
case 'w':
if (strcasecmp(optarg, "usec") == 0) {
mpiperf_timescale = MPIPERF_TIMESCALE_USEC;
} else if (strcasecmp(optarg, "sec") == 0) {
mpiperf_timescale = MPIPERF_TIMESCALE_SEC;
} else {
exit_error("Unknown time scale: %s", optarg);
}
break;
case 't':
mpiperf_timername = optarg;
break;
case 'T':
if (IS_MASTER_RANK) {
hpctimer_print_timers();
}
exit_success();
case 'g':
checktimer = 1;
break;
case 'm':
mpiperf_logmaster_only = 1;
break;
case 'q':
if (IS_MASTER_RANK) {
print_benchmarks_info();
}
exit_success();
case 'v':
if (IS_MASTER_RANK) {
print_version();
}
exit_success();
case 'h':
default:
if (IS_MASTER_RANK) {
print_usage(argc, argv);
}
exit_success();
}
}
if (checktimer) {
mpiperf_checktimer();
exit_success();
}
if (optind >= argc) {
if (IS_MASTER_RANK) {
print_usage(argc, argv);
print_error("Expected benchmark name");
}
return MPIPERF_FAILURE;
}
if ( (mpiperf_bench = lookup_bench(argv[optind])) == NULL) {
if (IS_MASTER_RANK) {
print_error("Unknown benchmark name");
}
return MPIPERF_FAILURE;
}
return MPIPERF_SUCCESS;
}
