X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/93ccaef0c60868bb1a6e0747387ce34c0172b53e..653ccd78fa6770c692f5a737ad70de5aedbfcc7f:/libguile/simpos.c diff --git a/libguile/simpos.c b/libguile/simpos.c index f6459c445..84b8b9d67 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -1,24 +1,25 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 Free Software +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2009, 2010 Free Software * Foundation, Inc. * * This library 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 2.1 of the License, or (at your option) any later version. + * 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. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library 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 this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ -#if HAVE_CONFIG_H +#ifdef HAVE_CONFIG_H # include #endif @@ -33,6 +34,7 @@ #include "libguile/validate.h" #include "libguile/simpos.h" +#include "libguile/dynwind.h" #ifdef HAVE_STRING_H #include @@ -63,8 +65,9 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, "indicating whether the command processor is available.") #define FUNC_NAME s_scm_system { - int rv; - + int rv, eno; + char *c_cmd; + if (SCM_UNBNDP (cmd)) { rv = system (NULL); @@ -72,10 +75,12 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, } SCM_VALIDATE_STRING (1, cmd); errno = 0; - rv = system (SCM_STRING_CHARS (cmd)); + 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_I_MAKINUM (rv); + return scm_from_int (rv); } #undef FUNC_NAME #endif /* HAVE_SYSTEM */ @@ -84,34 +89,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, #ifdef HAVE_SYSTEM #ifdef HAVE_WAITPID -/* return a newly allocated array of char pointers to each of the strings - in args, with a terminating NULL pointer. */ -/* Note: a similar function is defined in dynl.c, but we don't necessarily - want to export it. */ -static char ** -allocate_string_pointers (SCM args) -{ - char **result; - int n_args = scm_ilength (args); - int i; - - SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); - result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); - result[n_args] = NULL; - for (i = 0; i < n_args; i++) - { - SCM car = SCM_CAR (args); - - if (!SCM_STRINGP (car)) - { - free (result); - scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); - } - result[i] = SCM_STRING_CHARS (SCM_CAR (args)); - args = SCM_CDR (args); - } - return result; -} SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, (SCM args), @@ -133,10 +110,10 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, "Example: (system* \"echo\" \"foo\" \"bar\")") #define FUNC_NAME s_scm_system_star { - if (SCM_NULLP (args)) + if (scm_is_null (args)) SCM_WRONG_NUM_ARGS (); - if (SCM_CONSP (args)) + if (scm_is_pair (args)) { SCM oldint; SCM oldquit; @@ -146,14 +123,13 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, int pid; char **execargv; - SCM_VALIDATE_STRING (1, SCM_CAR (args)); /* allocate before fork */ - execargv = allocate_string_pointers (args); + execargv = scm_i_allocate_string_pointers (args); /* make sure the child can't kill us (as per normal system call) */ - sig_ign = scm_long2num ((long) SIG_IGN); - sigint = scm_long2num (SIGINT); - sigquit = scm_long2num (SIGQUIT); + sig_ign = scm_from_ulong ((unsigned long) SIG_IGN); + sigint = scm_from_int (SIGINT); + sigquit = scm_from_int (SIGQUIT); oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); @@ -161,8 +137,7 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, if (pid == 0) { /* child */ - execvp (SCM_STRING_CHARS (SCM_CAR (args)), execargv); - scm_remember_upto_here_1 (args); + execvp (execargv[0], execargv); SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; @@ -170,24 +145,22 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, else { /* parent */ - int wait_result, status, save_errno; + int wait_result, status; - save_errno = errno; - free (execargv); - errno = save_errno; if (pid == -1) SCM_SYSERROR; SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); - if (wait_result == -1) SCM_SYSERROR; + if (wait_result == -1) + SCM_SYSERROR; scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); - scm_remember_upto_here_2 (oldint, oldquit); - return SCM_I_MAKINUM (0L + status); + + return scm_from_int (status); } } else - SCM_WRONG_TYPE_ARG (1, SCM_CAR (args)); + SCM_WRONG_TYPE_ARG (1, args); } #undef FUNC_NAME #endif /* HAVE_WAITPID */ @@ -202,30 +175,47 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, #define FUNC_NAME s_scm_getenv { char *val; - SCM_VALIDATE_STRING (1, nam); - val = getenv (SCM_STRING_CHARS (nam)); - return val ? scm_mem2string (val, strlen (val)) : SCM_BOOL_F; + 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 /* 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 stack.\n" - "This is would typically be useful after a fork. The exit status\n" - "is @var{status} if supplied, otherwise zero.") + "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)) - { - SCM_VALIDATE_INUM (1, status); - cstatus = SCM_INUM (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 ()