/* Copyright 1995-1998,2000-2001,2003-2004,2009-2014,2018
Free Software Foundation, Inc.
This file is part of Guile.
Guile is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Guile is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public
License along with Guile. If not, see
. */
#ifdef HAVE_CONFIG_H
# include
#endif
#include
#include /* for getenv, system, exit, free */
#include /* for _exit */
#include "boolean.h"
#include "gsubr.h"
#include "numbers.h"
#include "strings.h"
#include "simpos.h"
SCM_DEFINE (scm_system, "system", 0, 1, 0,
(SCM cmd),
"Execute @var{cmd} using the operating system's \"command\n"
"processor\". Under Unix this is usually the default shell\n"
"@code{sh}. The value returned is @var{cmd}'s exit status as\n"
"returned by @code{waitpid}, which can be interpreted using\n"
"@code{status:exit-val} and friends.\n"
"\n"
"If @code{system} is called without arguments, return a boolean\n"
"indicating whether the command processor is available.")
#define FUNC_NAME s_scm_system
{
int rv, eno;
char *c_cmd;
if (SCM_UNBNDP (cmd))
{
rv = system (NULL);
return scm_from_bool (rv);
}
SCM_VALIDATE_STRING (1, cmd);
errno = 0;
c_cmd = scm_to_locale_string (cmd);
rv = system (c_cmd);
eno = errno; free (c_cmd); errno = eno;
if (rv == -1 || (rv == 127 && errno != 0))
SCM_SYSERROR;
return scm_from_int (rv);
}
#undef FUNC_NAME
SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
(SCM nam),
"Looks up the string @var{nam} in the current environment. The return\n"
"value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
"found, in which case the string @code{VALUE} is returned.")
#define FUNC_NAME s_scm_getenv
{
char *val;
char *var = scm_to_locale_string (nam);
val = getenv (var);
free (var);
return val ? scm_from_locale_string (val) : SCM_BOOL_F;
}
#undef FUNC_NAME
/* Get an integer from an environment variable. */
int
scm_getenv_int (const char *var, int def)
{
char *end = 0;
char *val = getenv (var);
long res = def;
if (!val)
return def;
res = strtol (val, &end, 10);
if (end == val)
return def;
return res;
}
/* simple exit, without unwinding the scheme stack or flushing ports. */
SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
(SCM status),
"Terminate the current process without unwinding the Scheme\n"
"stack. The exit status is @var{status} if supplied, otherwise\n"
"zero.")
#define FUNC_NAME s_scm_primitive_exit
{
int cstatus = 0;
if (!SCM_UNBNDP (status))
cstatus = scm_to_int (status);
exit (cstatus);
}
#undef FUNC_NAME
SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
(SCM status),
"Terminate the current process using the _exit() system call and\n"
"without unwinding the Scheme stack. The exit status is\n"
"@var{status} if supplied, otherwise zero.\n"
"\n"
"This function is typically useful after a fork, to ensure no\n"
"Scheme cleanups or @code{atexit} handlers are run (those\n"
"usually belonging in the parent rather than the child).")
#define FUNC_NAME s_scm_primitive__exit
{
int cstatus = 0;
if (!SCM_UNBNDP (status))
cstatus = scm_to_int (status);
_exit (cstatus);
}
#undef FUNC_NAME
void
scm_init_simpos ()
{
#include "simpos.x"
}