diff options
author | Greg J. Badros <gjb@cs.washington.edu> | 1999-12-12 02:36:16 +0000 |
---|---|---|
committer | Greg J. Badros <gjb@cs.washington.edu> | 1999-12-12 02:36:16 +0000 |
commit | 1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11 (patch) | |
tree | 79120a96365e0fa3324174bfd08d731ca8311d64 /libguile/posix.c | |
parent | 6e7069385db8cf96dfbe51cf65ace161942a32c9 (diff) | |
download | guile-1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11.tar.gz |
* *.c: Pervasive software-engineering-motivated rewrite of
function headers and argument checking. Switched SCM_PROC,
SCM_PROC1 macros to be GUILE_PROC, GUILE_PROC1 (may change names
later, but was useful to keep old versions around while migrate)
that has docstrings and argument lists embedded in the GUILE_PROC
macro invocations that expand into a function header. Use lots of
new SCM_VALIDATE_* macros to simplify error checking and reduce
tons of redundancy. This is very similar to what I did for Scwm.
Note that none of the extraction of the docstrings, nor software
engineering checks of Scwm is yet added to Guile. I'll work on
that tomorrow, I expect.
* Makefile.am: Added scm_validate.h to modinclude_HEADERS.
* chars.c: Added docstrings for the primitives defined in here.
* snarf.h: Added GUILE_PROC, GUILE_PROC1. Added
SCM_REGISTER_PROC to be like old SCM_PROC, though old SCM_PROC
still remains for now. Changed naming convention for the s_foo
string name of the primitive to be s_scm_foo for ease of use with
the macro.
* scm_validate.h: Lots of new SCM_VALIDATE macros to simplify
argument checking through guile. Maybe some of these should be
folded into the header file for the types they check, but for now
it was easiest to just stick them all in one place.
Diffstat (limited to 'libguile/posix.c')
-rw-r--r-- | libguile/posix.c | 588 |
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 () |