summaryrefslogtreecommitdiff
path: root/libguile/posix.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/posix.c')
-rw-r--r--libguile/posix.c588
1 files changed, 301 insertions, 287 deletions
diff --git a/libguile/posix.c b/libguile/posix.c
index 975e36026..d224dd16c 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -38,6 +38,10 @@
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
#include <stdio.h>
@@ -46,6 +50,7 @@
#include "scmsigs.h"
#include "feature.h"
+#include "scm_validate.h"
#include "posix.h"
@@ -161,49 +166,49 @@ extern char ** environ;
SCM_SYMBOL (sym_read_pipe, "read pipe");
SCM_SYMBOL (sym_write_pipe, "write pipe");
-SCM_PROC (s_pipe, "pipe", 0, 0, 0, scm_pipe);
-
-SCM
-scm_pipe ()
+GUILE_PROC (scm_pipe, "pipe", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_pipe
{
int fd[2], rv;
SCM p_rd, p_wt;
rv = pipe (fd);
if (rv)
- scm_syserror (s_pipe);
+ SCM_SYSERROR;
p_rd = scm_fdes_to_port (fd[0], "r", sym_read_pipe);
p_wt = scm_fdes_to_port (fd[1], "w", sym_write_pipe);
return scm_cons (p_rd, p_wt);
}
+#undef FUNC_NAME
#ifdef HAVE_GETGROUPS
-SCM_PROC (s_getgroups, "getgroups", 0, 0, 0, scm_getgroups);
-
-SCM
-scm_getgroups()
+GUILE_PROC (scm_getgroups, "getgroups", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getgroups
{
SCM grps, ans;
int ngroups = getgroups (0, NULL);
if (!ngroups)
- scm_syserror (s_getgroups);
+ SCM_SYSERROR;
SCM_NEWCELL(grps);
SCM_DEFER_INTS;
{
GETGROUPS_T *groups;
int val;
- groups = (GETGROUPS_T *) scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
- s_getgroups);
+ groups = SCM_MUST_MALLOC_TYPE_NUM(GETGROUPS_T,ngroups);
val = getgroups(ngroups, groups);
if (val < 0)
{
int en = errno;
scm_must_free((char *)groups);
errno = en;
- scm_syserror (s_getgroups);
+ SCM_SYSERROR;
}
SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
@@ -213,15 +218,15 @@ scm_getgroups()
SCM_ALLOW_INTS;
return ans;
}
-}
+}
+#undef FUNC_NAME
#endif
-SCM_PROC (s_getpwuid, "getpw", 0, 1, 0, scm_getpwuid);
-
-SCM
-scm_getpwuid (user)
- SCM user;
+GUILE_PROC (scm_getpwuid, "getpw", 0, 1, 0,
+ (SCM user),
+"")
+#define FUNC_NAME s_scm_getpwuid
{
SCM result;
struct passwd *entry;
@@ -243,13 +248,13 @@ scm_getpwuid (user)
}
else
{
- SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_getpwuid);
+ SCM_VALIDATE_ROSTRING(1,user);
if (SCM_SUBSTRP (user))
user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
entry = getpwnam (SCM_ROCHARS (user));
}
if (!entry)
- scm_misc_error (s_getpwuid, "entry not found", SCM_EOL);
+ SCM_MISC_ERROR ("entry not found", SCM_EOL);
ve[0] = scm_makfrom0str (entry->pw_name);
ve[1] = scm_makfrom0str (entry->pw_passwd);
@@ -266,14 +271,14 @@ scm_getpwuid (user)
ve[6] = scm_makfrom0str (entry->pw_shell);
return result;
}
+#undef FUNC_NAME
#ifdef HAVE_SETPWENT
-SCM_PROC (s_setpwent, "setpw", 0, 1, 0, scm_setpwent);
-
-SCM
-scm_setpwent (arg)
- SCM arg;
+GUILE_PROC (scm_setpwent, "setpw", 0, 1, 0,
+ (SCM arg),
+"")
+#define FUNC_NAME s_scm_setpwent
{
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
endpwent ();
@@ -281,16 +286,16 @@ scm_setpwent (arg)
setpwent ();
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
/* Combines getgrgid and getgrnam. */
-SCM_PROC (s_getgrgid, "getgr", 0, 1, 0, scm_getgrgid);
-
-SCM
-scm_getgrgid (name)
- SCM name;
+GUILE_PROC (scm_getgrgid, "getgr", 0, 1, 0,
+ (SCM name),
+"")
+#define FUNC_NAME s_scm_getgrgid
{
SCM result;
struct group *entry;
@@ -309,13 +314,12 @@ scm_getgrgid (name)
SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
else
{
- SCM_ASSERT (SCM_NIMP (name) && SCM_ROSTRINGP (name), name, SCM_ARG1,
- s_getgrgid);
+ SCM_VALIDATE_ROSTRING(1,name);
SCM_COERCE_SUBSTR (name);
SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name)));
}
if (!entry)
- scm_syserror (s_getgrgid);
+ SCM_SYSERROR;
ve[0] = scm_makfrom0str (entry->gr_name);
ve[1] = scm_makfrom0str (entry->gr_passwd);
@@ -323,14 +327,14 @@ scm_getgrgid (name)
ve[3] = scm_makfromstrs (-1, entry->gr_mem);
return result;
}
+#undef FUNC_NAME
-SCM_PROC (s_setgrent, "setgr", 0, 1, 0, scm_setgrent);
-
-SCM
-scm_setgrent (arg)
- SCM arg;
+GUILE_PROC (scm_setgrent, "setgr", 0, 1, 0,
+ (SCM arg),
+"")
+#define FUNC_NAME s_scm_setgrent
{
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
endgrent ();
@@ -338,65 +342,64 @@ scm_setgrent (arg)
setgrent ();
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_kill, "kill", 2, 0, 0, scm_kill);
-
-SCM
-scm_kill (pid, sig)
- SCM pid;
- SCM sig;
+GUILE_PROC (scm_kill, "kill", 2, 0, 0,
+ (SCM pid, SCM sig),
+"")
+#define FUNC_NAME s_scm_kill
{
- SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_kill);
- SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_kill);
+ SCM_VALIDATE_INT(1,pid);
+ SCM_VALIDATE_INT(2,sig);
/* Signal values are interned in scm_init_posix(). */
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
- scm_syserror (s_kill);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_waitpid, "waitpid", 1, 1, 0, scm_waitpid);
-
-SCM
-scm_waitpid (pid, options)
- SCM pid;
- SCM options;
+GUILE_PROC (scm_waitpid, "waitpid", 1, 1, 0,
+ (SCM pid, SCM options),
+"")
+#define FUNC_NAME s_scm_waitpid
{
#ifdef HAVE_WAITPID
int i;
int status;
int ioptions;
- SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_waitpid);
+ SCM_VALIDATE_INT(1,pid);
if (SCM_UNBNDP (options))
ioptions = 0;
else
{
- SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_waitpid);
+ SCM_VALIDATE_INT(2,options);
/* Flags are interned in scm_init_posix. */
ioptions = SCM_INUM (options);
}
SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
if (i == -1)
- scm_syserror (s_waitpid);
+ SCM_SYSERROR;
return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
#else
- scm_sysmissing (s_waitpid);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_status_exit_val, "status:exit-val", 1, 0, 0, scm_status_exit_val);
-SCM
-scm_status_exit_val (status)
- SCM status;
+GUILE_PROC (scm_status_exit_val, "status:exit-val", 1, 0, 0,
+ (SCM status),
+"")
+#define FUNC_NAME s_scm_status_exit_val
{
int lstatus;
- SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_exit_val);
+ SCM_VALIDATE_INT(1,status);
/* On Ultrix, the WIF... macros assume their argument is an lvalue;
go figure. SCM_INUM does not yield an lvalue. */
@@ -406,15 +409,16 @@ scm_status_exit_val (status)
else
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_status_term_sig, "status:term-sig", 1, 0, 0, scm_status_term_sig);
-SCM
-scm_status_term_sig (status)
- SCM status;
+GUILE_PROC (scm_status_term_sig, "status:term-sig", 1, 0, 0,
+ (SCM status),
+"")
+#define FUNC_NAME s_scm_status_term_sig
{
int lstatus;
- SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_term_sig);
+ SCM_VALIDATE_INT(1,status);
lstatus = SCM_INUM (status);
if (WIFSIGNALED (lstatus))
@@ -422,15 +426,16 @@ scm_status_term_sig (status)
else
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_status_stop_sig, "status:stop-sig", 1, 0, 0, scm_status_stop_sig);
-SCM
-scm_status_stop_sig (status)
- SCM status;
+GUILE_PROC (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
+ (SCM status),
+"")
+#define FUNC_NAME s_scm_status_stop_sig
{
int lstatus;
- SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_stop_sig);
+ SCM_VALIDATE_INT(1,status);
lstatus = SCM_INUM (status);
if (WIFSTOPPED (lstatus))
@@ -438,41 +443,45 @@ scm_status_stop_sig (status)
else
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
-
-SCM
-scm_getppid ()
+GUILE_PROC (scm_getppid, "getppid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getppid
{
return SCM_MAKINUM (0L + getppid ());
}
+#undef FUNC_NAME
-SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
-
-SCM
-scm_getuid ()
+GUILE_PROC (scm_getuid, "getuid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getuid
{
return SCM_MAKINUM (0L + getuid ());
}
+#undef FUNC_NAME
-SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
-
-SCM
-scm_getgid ()
+GUILE_PROC (scm_getgid, "getgid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getgid
{
return SCM_MAKINUM (0L + getgid ());
}
+#undef FUNC_NAME
-SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
-
-SCM
-scm_geteuid ()
+GUILE_PROC (scm_geteuid, "geteuid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_geteuid
{
#ifdef HAVE_GETEUID
return SCM_MAKINUM (0L + geteuid ());
@@ -480,13 +489,14 @@ scm_geteuid ()
return SCM_MAKINUM (0L + getuid ());
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
-
-SCM
-scm_getegid ()
+GUILE_PROC (scm_getegid, "getegid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getegid
{
#ifdef HAVE_GETEUID
return SCM_MAKINUM (0L + getegid ());
@@ -494,159 +504,167 @@ scm_getegid ()
return SCM_MAKINUM (0L + getgid ());
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_setuid, "setuid", 1, 0, 0, scm_setuid);
-
-SCM
-scm_setuid (id)
- SCM id;
+GUILE_PROC (scm_setuid, "setuid", 1, 0, 0,
+ (SCM id),
+"")
+#define FUNC_NAME s_scm_setuid
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setuid);
+ SCM_VALIDATE_INT(1,id);
if (setuid (SCM_INUM (id)) != 0)
- scm_syserror (s_setuid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_setgid, "setgid", 1, 0, 0, scm_setgid);
-
-SCM
-scm_setgid (id)
- SCM id;
+GUILE_PROC (scm_setgid, "setgid", 1, 0, 0,
+ (SCM id),
+"")
+#define FUNC_NAME s_scm_setgid
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setgid);
+ SCM_VALIDATE_INT(1,id);
if (setgid (SCM_INUM (id)) != 0)
- scm_syserror (s_setgid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_seteuid, "seteuid", 1, 0, 0, scm_seteuid);
-
-SCM
-scm_seteuid (id)
- SCM id;
+GUILE_PROC (scm_seteuid, "seteuid", 1, 0, 0,
+ (SCM id),
+"")
+#define FUNC_NAME s_scm_seteuid
{
int rv;
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_seteuid);
+ SCM_VALIDATE_INT(1,id);
#ifdef HAVE_SETEUID
rv = seteuid (SCM_INUM (id));
#else
rv = setuid (SCM_INUM (id));
#endif
if (rv != 0)
- scm_syserror (s_seteuid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#ifdef HAVE_SETEGID
-SCM_PROC (s_setegid, "setegid", 1, 0, 0, scm_setegid);
-
-SCM
-scm_setegid (id)
- SCM id;
+GUILE_PROC (scm_setegid, "setegid", 1, 0, 0,
+ (SCM id),
+"")
+#define FUNC_NAME s_scm_setegid
{
int rv;
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setegid);
+ SCM_VALIDATE_INT(1,id);
#ifdef HAVE_SETEUID
rv = setegid (SCM_INUM (id));
#else
rv = setgid (SCM_INUM (id));
#endif
if (rv != 0)
- scm_syserror (s_setegid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
-SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
-SCM
-scm_getpgrp ()
+GUILE_PROC (scm_getpgrp, "getpgrp", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getpgrp
{
int (*fn)();
fn = (int (*) ()) getpgrp;
return SCM_MAKINUM (fn (0));
}
+#undef FUNC_NAME
-SCM_PROC (s_setpgid, "setpgid", 2, 0, 0, scm_setpgid);
-SCM
-scm_setpgid (pid, pgid)
- SCM pid, pgid;
+GUILE_PROC (scm_setpgid, "setpgid", 2, 0, 0,
+ (SCM pid, SCM pgid),
+"")
+#define FUNC_NAME s_scm_setpgid
{
#ifdef HAVE_SETPGID
- SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
- SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
+ SCM_VALIDATE_INT(1,pid);
+ SCM_VALIDATE_INT(2,pgid);
/* FIXME(?): may be known as setpgrp. */
if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
- scm_syserror (s_setpgid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_setpgid);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid);
-SCM
-scm_setsid ()
+GUILE_PROC (scm_setsid, "setsid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_setsid
{
#ifdef HAVE_SETSID
pid_t sid = setsid ();
if (sid == -1)
- scm_syserror (s_setsid);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_setsid);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname);
-
-SCM
-scm_ttyname (port)
- SCM port;
+GUILE_PROC (scm_ttyname, "ttyname", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_ttyname
{
char *ans;
int fd;
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
+ SCM_VALIDATE_OPPORT(1,port);
if (scm_tc16_fport != SCM_TYP16 (port))
return SCM_BOOL_F;
fd = SCM_FPORT_FDES (port);
SCM_SYSCALL (ans = ttyname (fd));
if (!ans)
- scm_syserror (s_ttyname);
+ SCM_SYSERROR;
/* ans could be overwritten by another call to ttyname */
return (scm_makfrom0str (ans));
}
+#undef FUNC_NAME
-SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid);
-SCM
-scm_ctermid ()
+GUILE_PROC (scm_ctermid, "ctermid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_ctermid
{
#ifdef HAVE_CTERMID
char *result = ctermid (NULL);
if (*result == '\0')
- scm_syserror (s_ctermid);
+ SCM_SYSERROR;
return scm_makfrom0str (result);
#else
- scm_sysmissing (s_ctermid);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
-SCM
-scm_tcgetpgrp (port)
- SCM port;
+GUILE_PROC (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_tcgetpgrp
{
#ifdef HAVE_TCGETPGRP
int fd;
@@ -654,40 +672,43 @@ scm_tcgetpgrp (port)
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
+ SCM_VALIDATE_OPFPORT(1,port);
fd = SCM_FPORT_FDES (port);
if ((pgid = tcgetpgrp (fd)) == -1)
- scm_syserror (s_tcgetpgrp);
+ SCM_SYSERROR;
return SCM_MAKINUM (pgid);
#else
- scm_sysmissing (s_tcgetpgrp);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
-}
+}
+#undef FUNC_NAME
-SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
-SCM
-scm_tcsetpgrp (port, pgid)
- SCM port, pgid;
+GUILE_PROC (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
+ (SCM port, SCM pgid),
+"")
+#define FUNC_NAME s_scm_tcsetpgrp
{
#ifdef HAVE_TCSETPGRP
int fd;
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
- SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
+ SCM_VALIDATE_OPFPORT(1,port);
+ SCM_VALIDATE_INT(2,pgid);
fd = SCM_FPORT_FDES (port);
if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
- scm_syserror (s_tcsetpgrp);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_tcsetpgrp);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
-}
+}
+#undef FUNC_NAME
+
/* Copy exec args from an SCM vector into a new C array. */
@@ -722,39 +743,37 @@ scm_convert_exec_args (SCM args, int pos, const char *subr)
return execargv;
}
-SCM_PROC (s_execl, "execl", 1, 0, 1, scm_execl);
-
-SCM
-scm_execl (filename, args)
- SCM filename, args;
+GUILE_PROC (scm_execl, "execl", 1, 0, 1,
+ (SCM filename, SCM args),
+"")
+#define FUNC_NAME s_scm_execl
{
char **execargv;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
- SCM_ARG1, s_execl);
+ SCM_VALIDATE_ROSTRING(1,filename);
SCM_COERCE_SUBSTR (filename);
- execargv = scm_convert_exec_args (args, SCM_ARG2, s_execl);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
execv (SCM_ROCHARS (filename), execargv);
- scm_syserror (s_execl);
+ SCM_SYSERROR;
/* not reached. */
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_execlp, "execlp", 1, 0, 1, scm_execlp);
-
-SCM
-scm_execlp (filename, args)
- SCM filename, args;
+GUILE_PROC (scm_execlp, "execlp", 1, 0, 1,
+ (SCM filename, SCM args),
+"")
+#define FUNC_NAME s_scm_execlp
{
char **execargv;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
- SCM_ARG1, s_execlp);
+ SCM_VALIDATE_ROSTRING(1,filename);
SCM_COERCE_SUBSTR (filename);
- execargv = scm_convert_exec_args (args, SCM_ARG2, s_execlp);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
execvp (SCM_ROCHARS (filename), execargv);
- scm_syserror (s_execlp);
+ SCM_SYSERROR;
/* not reached. */
return SCM_BOOL_F;
}
+#undef FUNC_NAME
static char **
environ_list_to_c (SCM envlist, int arg, const char *proc)
@@ -792,51 +811,51 @@ environ_list_to_c (SCM envlist, int arg, const char *proc)
return result;
}
-SCM_PROC (s_execle, "execle", 2, 0, 1, scm_execle);
-
-SCM
-scm_execle (filename, env, args)
- SCM filename, env, args;
+GUILE_PROC (scm_execle, "execle", 2, 0, 1,
+ (SCM filename, SCM env, SCM args),
+"")
+#define FUNC_NAME s_scm_execle
{
char **execargv;
char **exec_env;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
- SCM_ARG1, s_execle);
+ SCM_VALIDATE_ROSTRING(1,filename);
SCM_COERCE_SUBSTR (filename);
- execargv = scm_convert_exec_args (args, SCM_ARG1, s_execle);
- exec_env = environ_list_to_c (env, SCM_ARG2, s_execle);
+ execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
+ exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
execve (SCM_ROCHARS (filename), execargv, exec_env);
- scm_syserror (s_execle);
+ SCM_SYSERROR;
/* not reached. */
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_fork, "primitive-fork", 0, 0, 0, scm_fork);
-
-SCM
-scm_fork()
+GUILE_PROC (scm_fork, "primitive-fork", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_fork
{
int pid;
pid = fork ();
if (pid == -1)
- scm_syserror (s_fork);
+ SCM_SYSERROR;
return SCM_MAKINUM (0L+pid);
}
+#undef FUNC_NAME
-SCM_PROC (s_uname, "uname", 0, 0, 0, scm_uname);
-
-SCM
-scm_uname ()
+GUILE_PROC (scm_uname, "uname", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_uname
{
#ifdef HAVE_UNAME
struct utsname buf;
SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0)
- scm_syserror (s_uname);
+ SCM_SYSERROR;
ve[0] = scm_makfrom0str (buf.sysname);
ve[1] = scm_makfrom0str (buf.nodename);
ve[2] = scm_makfrom0str (buf.release);
@@ -848,17 +867,17 @@ scm_uname ()
*/
return ans;
#else
- scm_sysmissing (s_uname);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
-
-SCM
-scm_environ (env)
- SCM env;
+GUILE_PROC (scm_environ, "environ", 0, 1, 0,
+ (SCM env),
+"")
+#define FUNC_NAME s_scm_environ
{
if (SCM_UNBNDP (env))
return scm_makfromstrs (-1, environ);
@@ -866,7 +885,7 @@ scm_environ (env)
{
char **new_environ;
- new_environ = environ_list_to_c (env, SCM_ARG1, s_environ);
+ new_environ = environ_list_to_c (env, SCM_ARG1, FUNC_NAME);
/* Free the old environment, except when called for the first
* time.
*/
@@ -885,151 +904,144 @@ scm_environ (env)
return SCM_UNSPECIFIED;
}
}
+#undef FUNC_NAME
#ifdef L_tmpnam
-SCM_PROC (s_tmpnam, "tmpnam", 0, 0, 0, scm_tmpnam);
-
-SCM scm_tmpnam()
+GUILE_PROC (scm_tmpnam, "tmpnam", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_tmpnam
{
char name[L_tmpnam];
SCM_SYSCALL (tmpnam (name););
return scm_makfrom0str (name);
}
-#endif
+#undef FUNC_NAME;
-SCM_PROC (s_utime, "utime", 1, 2, 0, scm_utime);
+#endif
-SCM
-scm_utime (pathname, actime, modtime)
- SCM pathname;
- SCM actime;
- SCM modtime;
+GUILE_PROC (scm_utime, "utime", 1, 2, 0,
+ (SCM pathname, SCM actime, SCM modtime),
+"")
+#define FUNC_NAME s_scm_utime
{
int rv;
struct utimbuf utm_tmp;
- SCM_ASSERT (SCM_NIMP (pathname) && SCM_ROSTRINGP (pathname), pathname,
- SCM_ARG1, s_utime);
-
+ SCM_VALIDATE_ROSTRING(1,pathname);
SCM_COERCE_SUBSTR (pathname);
if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime));
else
- utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_utime);
+ utm_tmp.actime = SCM_NUM2ULONG (2,actime);
if (SCM_UNBNDP (modtime))
SCM_SYSCALL (time (&utm_tmp.modtime));
else
- utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_utime);
+ utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
if (rv != 0)
- scm_syserror (s_utime);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_access, "access?", 2, 0, 0, scm_access);
-
-SCM
-scm_access (path, how)
- SCM path;
- SCM how;
+GUILE_PROC (scm_access, "access?", 2, 0, 0,
+ (SCM path, SCM how),
+"")
+#define FUNC_NAME s_scm_access
{
int rv;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_access);
+ SCM_VALIDATE_ROSTRING(1,path);
if (SCM_SUBSTRP (path))
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
- SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_access);
+ SCM_VALIDATE_INT(2,how);
rv = access (SCM_ROCHARS (path), SCM_INUM (how));
return rv ? SCM_BOOL_F : SCM_BOOL_T;
}
+#undef FUNC_NAME
-SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
-
-SCM
-scm_getpid ()
+GUILE_PROC (scm_getpid, "getpid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getpid
{
return SCM_MAKINUM ((unsigned long) getpid ());
}
+#undef FUNC_NAME
-SCM_PROC (s_putenv, "putenv", 1, 0, 0, scm_putenv);
-
-SCM
-scm_putenv (str)
- SCM str;
+GUILE_PROC (scm_putenv, "putenv", 1, 0, 0,
+ (SCM str),
+"")
+#define FUNC_NAME s_scm_putenv
{
int rv;
char *ptr;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_putenv);
+ SCM_VALIDATE_ROSTRING(1,str);
/* must make a new copy to be left in the environment, safe from gc. */
ptr = malloc (SCM_LENGTH (str) + 1);
if (ptr == NULL)
- scm_memory_error (s_putenv);
+ SCM_MEMORY_ERROR;
strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
ptr[SCM_LENGTH(str)] = 0;
rv = putenv (ptr);
if (rv < 0)
- scm_syserror (s_putenv);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale);
-
-SCM
-scm_setlocale (category, locale)
- SCM category;
- SCM locale;
+GUILE_PROC (scm_setlocale, "setlocale", 1, 1, 0,
+ (SCM category, SCM locale),
+"")
+#define FUNC_NAME s_scm_setlocale
{
#ifdef HAVE_SETLOCALE
char *clocale;
char *rv;
- SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
+ SCM_VALIDATE_INT(1,category);
if (SCM_UNBNDP (locale))
{
clocale = NULL;
}
else
{
- SCM_ASSERT (SCM_NIMP (locale) && SCM_ROSTRINGP (locale), locale,
- SCM_ARG2, s_setlocale);
+ SCM_VALIDATE_ROSTRING(2,locale);
SCM_COERCE_SUBSTR (locale);
clocale = SCM_ROCHARS (locale);
}
rv = setlocale (SCM_INUM (category), clocale);
if (rv == NULL)
- scm_syserror (s_setlocale);
+ SCM_SYSERROR;
return scm_makfrom0str (rv);
#else
- scm_sysmissing (s_setlocale);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_mknod, "mknod", 4, 0, 0, scm_mknod);
-
-SCM
-scm_mknod(path, type, perms, dev)
- SCM path;
- SCM type;
- SCM perms;
- SCM dev;
+GUILE_PROC (scm_mknod, "mknod", 4, 0, 0,
+ (SCM path, SCM type, SCM perms, SCM dev),
+"")
+#define FUNC_NAME s_scm_mknod
{
#ifdef HAVE_MKNOD
int val;
char *p;
int ctype = 0;
- SCM_ASSERT (SCM_NIMP(path) && SCM_ROSTRINGP(path), path, SCM_ARG1, s_mknod);
- SCM_ASSERT (SCM_NIMP(type) && SCM_SYMBOLP (type), type, SCM_ARG2, s_mknod);
- SCM_ASSERT (SCM_INUMP (perms), perms, SCM_ARG3, s_mknod);
- SCM_ASSERT (SCM_INUMP(dev), dev, SCM_ARG4, s_mknod);
+ SCM_VALIDATE_ROSTRING(1,path);
+ SCM_VALIDATE_SYMBOL(2,type);
+ SCM_VALIDATE_INT(3,perms);
+ SCM_VALIDATE_INT(4,dev);
SCM_COERCE_SUBSTR (path);
p = SCM_CHARS (type);
@@ -1048,53 +1060,55 @@ scm_mknod(path, type, perms, dev)
else if (strcmp (p, "socket") == 0)
ctype = S_IFSOCK;
else
- scm_out_of_range (s_mknod, type);
+ SCM_OUT_OF_RANGE (2,type);
SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms),
SCM_INUM (dev)));
if (val != 0)
- scm_syserror (s_mknod);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_mknod);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_nice, "nice", 1, 0, 0, scm_nice);
-
-SCM
-scm_nice(incr)
- SCM incr;
+GUILE_PROC (scm_nice, "nice", 1, 0, 0,
+ (SCM incr),
+"")
+#define FUNC_NAME s_scm_nice
{
#ifdef HAVE_NICE
- SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_nice);
+ SCM_VALIDATE_INT(1,incr);
if (nice(SCM_INUM(incr)) != 0)
- scm_syserror (s_nice);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_nice);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
-
-SCM
-scm_sync()
+GUILE_PROC (scm_sync, "sync", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_sync
{
#ifdef HAVE_SYNC
sync();
#else
- scm_sysmissing (s_sync);
+ SCM_SYSMISSING;
/* not reached. */
#endif
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
void
scm_init_posix ()