getgroups (ngroups, groups);
ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
- while (--ngroups >= 0)
- SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
+ {
+ SCM * ve = SCM_WRITABLE_VELTS(ans);
+
+ while (--ngroups >= 0)
+ ve[ngroups] = SCM_MAKINUM (groups [ngroups]);
+ }
free (groups);
return ans;
}
"or getpwent respectively.")
#define FUNC_NAME s_scm_getpwuid
{
- SCM result;
struct passwd *entry;
- SCM *ve;
- result = scm_c_make_vector (7, SCM_UNSPECIFIED);
- ve = SCM_VELTS (result);
+ SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED);
if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{
SCM_SYSCALL (entry = getpwent ());
if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL);
- ve[0] = scm_makfrom0str (entry->pw_name);
- ve[1] = scm_makfrom0str (entry->pw_passwd);
- ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
- ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
- ve[4] = scm_makfrom0str (entry->pw_gecos);
+ SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name));
+ SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd));
+ SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
+ SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
+ SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos));
if (!entry->pw_dir)
- ve[5] = scm_makfrom0str ("");
+ SCM_VECTOR_SET(ans, 5, scm_makfrom0str (""));
else
- ve[5] = scm_makfrom0str (entry->pw_dir);
+ SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir));
if (!entry->pw_shell)
- ve[6] = scm_makfrom0str ("");
+ SCM_VECTOR_SET(ans, 6, scm_makfrom0str (""));
else
- ve[6] = scm_makfrom0str (entry->pw_shell);
- return result;
+ SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell));
+ return ans;
}
#undef FUNC_NAME
#endif /* HAVE_GETPWENT */
"or getgrent respectively.")
#define FUNC_NAME s_scm_getgrgid
{
- SCM result;
struct group *entry;
- SCM *ve;
- result = scm_c_make_vector (4, SCM_UNSPECIFIED);
- ve = SCM_VELTS (result);
+ SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
+
if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{
SCM_SYSCALL (entry = getgrent ());
if (!entry)
SCM_SYSERROR;
- ve[0] = scm_makfrom0str (entry->gr_name);
- ve[1] = scm_makfrom0str (entry->gr_passwd);
- ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
- ve[3] = scm_makfromstrs (-1, entry->gr_mem);
- return result;
+ SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name));
+ SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd));
+ SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
+ SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem));
+ return ans;
}
#undef FUNC_NAME
"@end defvar")
#define FUNC_NAME s_scm_kill
{
- SCM_VALIDATE_INUM (1,pid);
- SCM_VALIDATE_INUM (2,sig);
+ SCM_VALIDATE_INUM (1, pid);
+ SCM_VALIDATE_INUM (2, sig);
/* Signal values are interned in scm_init_posix(). */
#ifdef HAVE_KILL
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
int i;
int status;
int ioptions;
- SCM_VALIDATE_INUM (1,pid);
+ SCM_VALIDATE_INUM (1, pid);
if (SCM_UNBNDP (options))
ioptions = 0;
else
{
- SCM_VALIDATE_INUM (2,options);
+ SCM_VALIDATE_INUM (2, options);
/* Flags are interned in scm_init_posix. */
ioptions = SCM_INUM (options);
}
{
int lstatus;
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
/* On Ultrix, the WIF... macros assume their argument is an lvalue;
go figure. SCM_INUM does not yield an lvalue. */
{
int lstatus;
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
if (WIFSIGNALED (lstatus))
{
int lstatus;
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
if (WIFSTOPPED (lstatus))
"The return value is unspecified.")
#define FUNC_NAME s_scm_setuid
{
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
if (setuid (SCM_INUM (id)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
"The return value is unspecified.")
#define FUNC_NAME s_scm_setgid
{
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
if (setgid (SCM_INUM (id)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
{
int rv;
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = seteuid (SCM_INUM (id));
#else
{
int rv;
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = setegid (SCM_INUM (id));
#else
"The return value is unspecified.")
#define FUNC_NAME s_scm_setpgid
{
- SCM_VALIDATE_INUM (1,pid);
- SCM_VALIDATE_INUM (2,pgid);
+ SCM_VALIDATE_INUM (1, pid);
+ SCM_VALIDATE_INUM (2, pgid);
/* FIXME(?): may be known as setpgrp. */
if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
SCM_SYSERROR;
int fd;
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPPORT (1,port);
+ SCM_VALIDATE_OPPORT (1, port);
if (!SCM_FPORTP (port))
return SCM_BOOL_F;
fd = SCM_FPORT_FDES (port);
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPFPORT (1,port);
+ SCM_VALIDATE_OPFPORT (1, port);
fd = SCM_FPORT_FDES (port);
if ((pgid = tcgetpgrp (fd)) == -1)
SCM_SYSERROR;
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPFPORT (1,port);
- SCM_VALIDATE_INUM (2,pgid);
+ SCM_VALIDATE_OPFPORT (1, port);
+ SCM_VALIDATE_INUM (2, pgid);
fd = SCM_FPORT_FDES (port);
if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
SCM_SYSERROR;
#undef FUNC_NAME
#endif /* HAVE_TCSETPGRP */
-/* Create a new C argv array from a scheme list of strings. */
-/* Dirk:FIXME:: A quite similar function is implemented in dynl.c */
-/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */
-
-static char **
-scm_convert_exec_args (SCM args, int argn, const char *subr)
+/* 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 **argv;
- int argc;
+ char **result;
+ int n_args = scm_ilength (args);
int i;
- argc = scm_ilength (args);
- SCM_ASSERT (argc >= 0, args, argn, subr);
- argv = (char **) scm_malloc ((argc + 1) * sizeof (char *));
- for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++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 arg = SCM_CAR (args);
- size_t len;
- char *dst;
- char *src;
+ SCM car = SCM_CAR (args);
- SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
- len = SCM_STRING_LENGTH (arg);
- src = SCM_STRING_CHARS (arg);
- dst = (char *) scm_malloc (len + 1);
- memcpy (dst, src, len);
- dst[len] = 0;
- argv[i] = dst;
+ 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);
}
- argv[i] = 0;
- return argv;
+ return result;
}
SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
{
char **execargv;
SCM_VALIDATE_STRING (1, filename);
- execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
+ execargv = allocate_string_pointers (args);
execv (SCM_STRING_CHARS (filename), execargv);
SCM_SYSERROR;
/* not reached. */
{
char **execargv;
SCM_VALIDATE_STRING (1, filename);
- execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
+ execargv = allocate_string_pointers (args);
execvp (SCM_STRING_CHARS (filename), execargv);
SCM_SYSERROR;
/* not reached. */
SCM_VALIDATE_STRING (1, filename);
- execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
+ execargv = allocate_string_pointers (args);
exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
execve (SCM_STRING_CHARS (filename), execargv, exec_env);
SCM_SYSERROR;
{
struct utsname buf;
SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
- SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0)
SCM_SYSERROR;
- ve[0] = scm_makfrom0str (buf.sysname);
- ve[1] = scm_makfrom0str (buf.nodename);
- ve[2] = scm_makfrom0str (buf.release);
- ve[3] = scm_makfrom0str (buf.version);
- ve[4] = scm_makfrom0str (buf.machine);
+ SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname));
+ SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename));
+ SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release));
+ SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version));
+ SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine));
/*
a linux special?
- ve[5] = scm_makfrom0str (buf.domainname);
+ SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname));
*/
return ans;
}
char *ptr;
SCM_VALIDATE_STRING (1, str);
- /* must make a new copy to be left in the environment, safe from gc. */
- ptr = malloc (SCM_STRING_LENGTH (str) + 1);
- if (ptr == NULL)
- SCM_MEMORY_ERROR;
- strncpy (ptr, SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str));
- ptr[SCM_STRING_LENGTH (str)] = 0;
- rv = putenv (ptr);
- if (rv < 0)
- SCM_SYSERROR;
+
+ if (strchr (SCM_STRING_CHARS (str), '=') == NULL)
+ {
+ /* No '=' in argument means we should remove the variable from
+ the environment. Not all putenvs understand this. To be
+ safe, we do it explicitely using unsetenv. */
+ unsetenv (SCM_STRING_CHARS (str));
+ }
+ else
+ {
+ /* must make a new copy to be left in the environment, safe from gc. */
+ ptr = malloc (SCM_STRING_LENGTH (str) + 1);
+ if (ptr == NULL)
+ SCM_MEMORY_ERROR;
+ strncpy (ptr, SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str));
+ ptr[SCM_STRING_LENGTH (str)] = 0;
+ rv = putenv (ptr);
+ if (rv < 0)
+ SCM_SYSERROR;
+ }
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
char *clocale;
char *rv;
- SCM_VALIDATE_INUM (1,category);
+ SCM_VALIDATE_INUM (1, category);
if (SCM_UNBNDP (locale))
{
clocale = NULL;
int ctype = 0;
SCM_VALIDATE_STRING (1, path);
- SCM_VALIDATE_SYMBOL (2,type);
- SCM_VALIDATE_INUM (3,perms);
- SCM_VALIDATE_INUM (4,dev);
+ SCM_VALIDATE_SYMBOL (2, type);
+ SCM_VALIDATE_INUM (3, perms);
+ SCM_VALIDATE_INUM (4, dev);
p = SCM_SYMBOL_CHARS (type);
if (strcmp (p, "regular") == 0)
ctype = S_IFSOCK;
#endif
else
- SCM_OUT_OF_RANGE (2,type);
+ SCM_OUT_OF_RANGE (2, type);
SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms),
SCM_INUM (dev)));
"The return value is unspecified.")
#define FUNC_NAME s_scm_nice
{
- SCM_VALIDATE_INUM (1,incr);
+ SCM_VALIDATE_INUM (1, incr);
if (nice(SCM_INUM(incr)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
HCoop / bpt / guile.git / blobdiff