summaryrefslogtreecommitdiff
path: root/libguile/filesys.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/filesys.c')
-rw-r--r--libguile/filesys.c495
1 files changed, 233 insertions, 262 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1d857dbed..258d8f7a1 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.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>
#include "_scm.h"
@@ -47,6 +51,7 @@
#include "fports.h"
#include "iselect.h"
+#include "scm_validate.h"
#include "filesys.h"
@@ -117,21 +122,18 @@
/* {Permissions}
*/
-SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
-
-SCM
-scm_chown (object, owner, group)
- SCM object;
- SCM owner;
- SCM group;
+GUILE_PROC (scm_chown, "chown", 3, 0, 0,
+ (SCM object, SCM owner, SCM group),
+"")
+#define FUNC_NAME s_scm_chown
{
int rv;
int fdes;
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown);
- SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
+ SCM_VALIDATE_INT(2,owner);
+ SCM_VALIDATE_INT(3,group);
if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
{
if (SCM_INUMP (object))
@@ -143,30 +145,29 @@ scm_chown (object, owner, group)
else
{
SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_chown);
+ object, SCM_ARG1, FUNC_NAME);
SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
SCM_INUM (owner), SCM_INUM (group)));
}
if (rv == -1)
- scm_syserror (s_chown);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
-
-SCM
-scm_chmod (object, mode)
- SCM object;
- SCM mode;
+GUILE_PROC (scm_chmod, "chmod", 2, 0, 0,
+ (SCM object, SCM mode),
+"")
+#define FUNC_NAME s_scm_chmod
{
int rv;
int fdes;
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
+ SCM_VALIDATE_INT(2,mode);
if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
{
if (SCM_INUMP (object))
@@ -177,21 +178,20 @@ scm_chmod (object, mode)
}
else
{
- SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_chmod);
+ SCM_VALIDATE_ROSTRING(1,object);
SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
}
if (rv == -1)
- scm_syserror (s_chmod);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask);
-
-SCM
-scm_umask (mode)
- SCM mode;
+GUILE_PROC (scm_umask, "umask", 0, 1, 0,
+ (SCM mode),
+"")
+#define FUNC_NAME s_scm_umask
{
mode_t mask;
if (SCM_UNBNDP (mode))
@@ -201,43 +201,39 @@ scm_umask (mode)
}
else
{
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG1, s_umask);
+ SCM_VALIDATE_INT(1,mode);
mask = umask (SCM_INUM (mode));
}
return SCM_MAKINUM (mask);
}
+#undef FUNC_NAME
-SCM_PROC (s_open_fdes, "open-fdes", 2, 1, 0, scm_open_fdes);
-SCM
-scm_open_fdes (SCM path, SCM flags, SCM mode)
+GUILE_PROC (scm_open_fdes, "open-fdes", 2, 1, 0,
+ (SCM path, SCM flags, SCM mode),
+"")
+#define FUNC_NAME s_scm_open_fdes
{
int fd;
int iflags;
int imode;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_open_fdes);
+ SCM_VALIDATE_ROSTRING(1,path);
SCM_COERCE_SUBSTR (path);
- iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
-
- if (SCM_UNBNDP (mode))
- imode = 0666;
- else
- {
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open_fdes);
- imode = SCM_INUM (mode);
- }
+ SCM_VALIDATE_INT_COPY(2,flags,iflags);
+ SCM_VALIDATE_INT_DEF_COPY(3,mode,0666,imode);
SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
if (fd == -1)
- scm_syserror (s_open_fdes);
+ SCM_SYSERROR;
return SCM_MAKINUM (fd);
}
+#undef FUNC_NAME
-SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
-SCM
-scm_open (SCM path, SCM flags, SCM mode)
+GUILE_PROC (scm_open, "open", 2, 1, 0,
+ (SCM path, SCM flags, SCM mode),
+"")
+#define FUNC_NAME s_scm_open
{
SCM newpt;
char *port_mode;
@@ -245,7 +241,7 @@ scm_open (SCM path, SCM flags, SCM mode)
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
- iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
+ SCM_VALIDATE_INT_COPY(2,flags,iflags);
if (iflags & O_RDWR)
{
if (iflags & O_APPEND)
@@ -266,10 +262,12 @@ scm_open (SCM path, SCM flags, SCM mode)
newpt = scm_fdes_to_port (fd, port_mode, path);
return newpt;
}
+#undef FUNC_NAME
-SCM_PROC (s_close, "close", 1, 0, 0, scm_close);
-SCM
-scm_close (SCM fd_or_port)
+GUILE_PROC (scm_close, "close", 1, 0, 0,
+ (SCM fd_or_port),
+"")
+#define FUNC_NAME s_scm_close
{
int rv;
int fd;
@@ -278,16 +276,17 @@ scm_close (SCM fd_or_port)
if (SCM_NIMP (fd_or_port) && SCM_PORTP (fd_or_port))
return scm_close_port (fd_or_port);
- SCM_ASSERT (SCM_INUMP (fd_or_port), fd_or_port, SCM_ARG1, s_close);
+ SCM_VALIDATE_INT(1,fd_or_port);
fd = SCM_INUM (fd_or_port);
scm_evict_ports (fd); /* see scsh manual. */
SCM_SYSCALL (rv = close (fd));
/* following scsh, closing an already closed file descriptor is
not an error. */
if (rv < 0 && errno != EBADF)
- scm_syserror (s_close);
- return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
+ SCM_SYSERROR;
+ return SCM_NEGATE_BOOL(rv < 0);
}
+#undef FUNC_NAME
/* {Files}
@@ -304,11 +303,8 @@ SCM_SYMBOL (scm_sym_fifo, "fifo");
SCM_SYMBOL (scm_sym_sock, "socket");
SCM_SYMBOL (scm_sym_unknown, "unknown");
-static SCM scm_stat2scm SCM_P ((struct stat *stat_temp));
-
static SCM
-scm_stat2scm (stat_temp)
- struct stat *stat_temp;
+scm_stat2scm (struct stat *stat_temp)
{
SCM ans = scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
@@ -397,11 +393,10 @@ scm_stat2scm (stat_temp)
return ans;
}
-SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
-
-SCM
-scm_stat (object)
- SCM object;
+GUILE_PROC (scm_stat, "stat", 1, 0, 0,
+ (SCM object),
+"")
+#define FUNC_NAME s_scm_stat
{
int rv;
int fdes;
@@ -411,7 +406,7 @@ scm_stat (object)
SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp));
else
{
- SCM_ASSERT (SCM_NIMP (object), object, SCM_ARG1, s_stat);
+ SCM_VALIDATE_NIMP(1,object);
if (SCM_ROSTRINGP (object))
{
SCM_COERCE_SUBSTR (object);
@@ -420,7 +415,7 @@ scm_stat (object)
else
{
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_OPFPORTP (object), object, SCM_ARG1, s_stat);
+ SCM_ASSERT (SCM_OPFPORTP (object), object, SCM_ARG1, FUNC_NAME);
fdes = SCM_FPORT_FDES (object);
SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
}
@@ -429,7 +424,7 @@ scm_stat (object)
{
int en = errno;
- scm_syserror_msg (s_stat, "%s: %S",
+ scm_syserror_msg (FUNC_NAME, "%s: %S",
scm_listify (scm_makfrom0str (strerror (errno)),
object,
SCM_UNDEFINED),
@@ -437,50 +432,44 @@ scm_stat (object)
}
return scm_stat2scm (&stat_temp);
}
+#undef FUNC_NAME
/* {Modifying Directories}
*/
-SCM_PROC (s_link, "link", 2, 0, 0, scm_link);
-
-SCM
-scm_link (oldpath, newpath)
- SCM oldpath;
- SCM newpath;
+GUILE_PROC (scm_link, "link", 2, 0, 0,
+ (SCM oldpath, SCM newpath),
+"")
+#define FUNC_NAME s_scm_link
{
int val;
- SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath,
- SCM_ARG1, s_link);
+ SCM_VALIDATE_ROSTRING(1,oldpath);
if (SCM_SUBSTRP (oldpath))
oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
SCM_ROLENGTH (oldpath), 0);
- SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath,
- SCM_ARG2, s_link);
+ SCM_VALIDATE_ROSTRING(2,newpath);
if (SCM_SUBSTRP (newpath))
newpath = scm_makfromstr (SCM_ROCHARS (newpath),
SCM_ROLENGTH (newpath), 0);
SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0)
- scm_syserror (s_link);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_rename, "rename-file", 2, 0, 0, scm_rename);
-
-SCM
-scm_rename (oldname, newname)
- SCM oldname;
- SCM newname;
+GUILE_PROC (scm_rename, "rename-file", 2, 0, 0,
+ (SCM oldname, SCM newname),
+"")
+#define FUNC_NAME s_scm_rename
{
int rv;
- SCM_ASSERT (SCM_NIMP (oldname) && SCM_ROSTRINGP (oldname), oldname, SCM_ARG1,
- s_rename);
- SCM_ASSERT (SCM_NIMP (newname) && SCM_ROSTRINGP (newname), newname, SCM_ARG2,
- s_rename);
+ SCM_VALIDATE_ROSTRING(1,oldname);
+ SCM_VALIDATE_ROSTRING(2,newname);
SCM_COERCE_SUBSTR (oldname);
SCM_COERCE_SUBSTR (newname);
#ifdef HAVE_RENAME
@@ -496,39 +485,36 @@ scm_rename (oldname, newname)
}
#endif
if (rv != 0)
- scm_syserror (s_rename);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC(s_delete_file, "delete-file", 1, 0, 0, scm_delete_file);
-
-SCM
-scm_delete_file (str)
- SCM str;
+GUILE_PROC(scm_delete_file, "delete-file", 1, 0, 0,
+ (SCM str),
+"")
+#define FUNC_NAME s_scm_delete_file
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1,
- s_delete_file);
+ SCM_VALIDATE_ROSTRING(1,str);
SCM_COERCE_SUBSTR (str);
SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
if (ans != 0)
- scm_syserror (s_delete_file);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
-
-SCM
-scm_mkdir (path, mode)
- SCM path;
- SCM mode;
+GUILE_PROC (scm_mkdir, "mkdir", 1, 1, 0,
+ (SCM path, SCM mode),
+"")
+#define FUNC_NAME s_scm_mkdir
{
#ifdef HAVE_MKDIR
int rv;
mode_t mask;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_mkdir);
+ SCM_VALIDATE_ROSTRING(1,path);
SCM_COERCE_SUBSTR (path);
if (SCM_UNBNDP (mode))
{
@@ -538,42 +524,42 @@ scm_mkdir (path, mode)
}
else
{
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir);
+ SCM_VALIDATE_INT(2,mode);
SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), SCM_INUM (mode)));
}
if (rv != 0)
- scm_syserror (s_mkdir);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_mkdir);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_rmdir, "rmdir", 1, 0, 0, scm_rmdir);
-
-SCM
-scm_rmdir (path)
- SCM path;
+GUILE_PROC (scm_rmdir, "rmdir", 1, 0, 0,
+ (SCM path),
+"")
+#define FUNC_NAME s_scm_rmdir
{
#ifdef HAVE_RMDIR
int val;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_rmdir);
+ SCM_VALIDATE_ROSTRING(1,path);
SCM_COERCE_SUBSTR (path);
SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
if (val != 0)
- scm_syserror (s_rmdir);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_rmdir);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
/* {Examining Directories}
@@ -581,86 +567,85 @@ scm_rmdir (path)
long scm_tc16_dir;
-SCM_PROC (s_directory_stream_p, "directory-stream?", 1, 0, 0, scm_directory_stream_p);
-SCM
-scm_directory_stream_p (SCM obj)
+GUILE_PROC (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
+ (SCM obj),
+"")
+#define FUNC_NAME s_scm_directory_stream_p
{
- return SCM_NIMP (obj) && SCM_DIRP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_NIMP (obj) && SCM_DIRP (obj));
}
+#undef FUNC_NAME
-SCM_PROC (s_opendir, "opendir", 1, 0, 0, scm_opendir);
-
-SCM
-scm_opendir (dirname)
- SCM dirname;
+GUILE_PROC (scm_opendir, "opendir", 1, 0, 0,
+ (SCM dirname),
+"")
+#define FUNC_NAME s_scm_opendir
{
DIR *ds;
- SCM_ASSERT (SCM_NIMP (dirname) && SCM_ROSTRINGP (dirname), dirname, SCM_ARG1,
- s_opendir);
+ SCM_VALIDATE_ROSTRING(1,dirname);
SCM_COERCE_SUBSTR (dirname);
SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname)));
if (ds == NULL)
- scm_syserror (s_opendir);
+ SCM_SYSERROR;
SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds);
}
+#undef FUNC_NAME
-SCM_PROC (s_readdir, "readdir", 1, 0, 0, scm_readdir);
-
-SCM
-scm_readdir (port)
- SCM port;
+GUILE_PROC (scm_readdir, "readdir", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_readdir
{
struct dirent *rdent;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_readdir);
+ SCM_VALIDATE_OPDIR(1,port);
errno = 0;
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
if (errno != 0)
- scm_syserror (s_readdir);
+ SCM_SYSERROR;
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
: SCM_EOF_VAL);
}
+#undef FUNC_NAME
-SCM_PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
-
-SCM
-scm_rewinddir (port)
- SCM port;
+GUILE_PROC (scm_rewinddir, "rewinddir", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_rewinddir
{
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_rewinddir);
+ SCM_VALIDATE_OPDIR(1,port);
rewinddir ((DIR *) SCM_CDR (port));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_closedir, "closedir", 1, 0, 0, scm_closedir);
-
-SCM
-scm_closedir (port)
- SCM port;
+GUILE_PROC (scm_closedir, "closedir", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_closedir
{
int sts;
- SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_closedir);
+ SCM_VALIDATE_DIR(1,port);
if (SCM_CLOSEDP (port))
{
return SCM_UNSPECIFIED;
}
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
if (sts != 0)
- scm_syserror (s_closedir);
+ SCM_SYSERROR;
SCM_SETCAR (port, scm_tc16_dir);
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-static int scm_dir_print SCM_P ((SCM sexp, SCM port, scm_print_state *pstate));
-
static int
scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
{
@@ -674,11 +659,8 @@ scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
}
-static scm_sizet scm_dir_free SCM_P ((SCM p));
-
static scm_sizet
-scm_dir_free (p)
- SCM p;
+scm_dir_free (SCM p)
{
if (SCM_OPENP (p))
closedir ((DIR *) SCM_CDR (p));
@@ -690,28 +672,28 @@ scm_dir_free (p)
*/
-SCM_PROC (s_chdir, "chdir", 1, 0, 0, scm_chdir);
-
-SCM
-scm_chdir (str)
- SCM str;
+GUILE_PROC (scm_chdir, "chdir", 1, 0, 0,
+ (SCM str),
+"")
+#define FUNC_NAME s_scm_chdir
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
+ SCM_VALIDATE_ROSTRING(1,str);
SCM_COERCE_SUBSTR (str);
SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
if (ans != 0)
- scm_syserror (s_chdir);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_getcwd, "getcwd", 0, 0, 0, scm_getcwd);
-
-SCM
-scm_getcwd ()
+GUILE_PROC (scm_getcwd, "getcwd", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_getcwd
{
#ifdef HAVE_GETCWD
char *rv;
@@ -720,30 +702,28 @@ scm_getcwd ()
char *wd;
SCM result;
- wd = scm_must_malloc (size, s_getcwd);
+ wd = scm_must_malloc (size, FUNC_NAME);
while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
{
scm_must_free (wd);
size *= 2;
- wd = scm_must_malloc (size, s_getcwd);
+ wd = scm_must_malloc (size, FUNC_NAME);
}
if (rv == 0)
- scm_syserror (s_getcwd);
+ SCM_SYSERROR;
result = scm_makfromstr (wd, strlen (wd), 0);
scm_must_free (wd);
return result;
#else
- scm_sysmissing (s_getcwd);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_select, "select", 3, 2, 0, scm_select);
-
-
static int
set_element (SELECT_TYPE *set, SCM element, int arg)
{
@@ -752,7 +732,7 @@ set_element (SELECT_TYPE *set, SCM element, int arg)
if (SCM_NIMP (element) && SCM_OPFPORTP (element))
fd = SCM_FPORT_FDES (element);
else {
- SCM_ASSERT (SCM_INUMP (element), element, arg, s_select);
+ SCM_ASSERT (SCM_INUMP (element), element, arg, "select");
fd = SCM_INUM (element);
}
FD_SET (fd, set);
@@ -836,14 +816,11 @@ retrieve_select_type (SELECT_TYPE *set, SCM list)
}
}
-
-SCM
-scm_select (reads, writes, excepts, secs, usecs)
- SCM reads;
- SCM writes;
- SCM excepts;
- SCM secs;
- SCM usecs;
+/* Static helper functions above refer to s_scm_select directly as s_select */
+GUILE_PROC (scm_select, "select", 3, 2, 0,
+ (SCM reads, SCM writes, SCM excepts, SCM secs, SCM usecs),
+"")
+#define FUNC_NAME s_scm_select
{
#ifdef HAVE_SELECT
struct timeval timeout;
@@ -855,8 +832,8 @@ scm_select (reads, writes, excepts, secs, usecs)
int sreturn;
#define assert_set(x, arg) \
- SCM_ASSERT (scm_ilength (x) > -1 || (SCM_NIMP (x) && SCM_VECTORP (x)), \
- x, arg, s_select)
+ SCM_ASSERT (scm_ilength (x) >= 0 || (SCM_NIMP (x) && SCM_VECTORP (x)), \
+ x, arg, FUNC_NAME)
assert_set (reads, SCM_ARG1);
assert_set (writes, SCM_ARG2);
assert_set (excepts, SCM_ARG3);
@@ -885,19 +862,18 @@ scm_select (reads, writes, excepts, secs, usecs)
timeout.tv_usec = 0;
else
{
- SCM_ASSERT (SCM_INUMP (usecs), usecs, SCM_ARG5, s_select);
-
+ SCM_VALIDATE_INT(5,usecs);
timeout.tv_usec = SCM_INUM (usecs);
}
}
else
{
- double fl = scm_num2dbl (secs, s_select);
+ double fl = scm_num2dbl (secs, FUNC_NAME);
if (!SCM_UNBNDP (usecs))
- scm_wrong_type_arg (s_select, 4, secs);
+ scm_wrong_type_arg (FUNC_NAME, 4, secs);
if (fl > LONG_MAX)
- scm_out_of_range (s_select, secs);
+ scm_out_of_range (FUNC_NAME, secs);
timeout.tv_sec = (long) fl;
timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000);
}
@@ -912,23 +888,25 @@ scm_select (reads, writes, excepts, secs, usecs)
&read_set, &write_set, &except_set, time_p);
#endif
if (sreturn < 0)
- scm_syserror (s_select);
+ SCM_SYSERROR;
return scm_listify (retrieve_select_type (&read_set, reads),
retrieve_select_type (&write_set, writes),
retrieve_select_type (&except_set, excepts),
SCM_UNDEFINED);
#else
- scm_sysmissing (s_select);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_fcntl, "fcntl", 2, 0, 1, scm_fcntl);
-SCM
-scm_fcntl (SCM object, SCM cmd, SCM value)
+GUILE_PROC (scm_fcntl, "fcntl", 2, 0, 1,
+ (SCM object, SCM cmd, SCM value),
+"")
+#define FUNC_NAME s_scm_fcntl
{
int rv;
int fdes;
@@ -936,30 +914,32 @@ scm_fcntl (SCM object, SCM cmd, SCM value)
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_INUMP (cmd), cmd, SCM_ARG2, s_fcntl);
+ SCM_VALIDATE_INT(2,cmd);
if (SCM_NIMP (object) && SCM_OPFPORTP (object))
fdes = SCM_FPORT_FDES (object);
else
{
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fcntl);
+ SCM_VALIDATE_INT(1,object);
fdes = SCM_INUM (object);
}
if (SCM_NULLP (value))
ivalue = 0;
else
{
- SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, s_fcntl);
+ SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, FUNC_NAME);
ivalue = SCM_INUM (SCM_CAR (value));
}
SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
if (rv == -1)
- scm_syserror (s_fcntl);
+ SCM_SYSERROR;
return SCM_MAKINUM (rv);
}
+#undef FUNC_NAME
-SCM_PROC (s_fsync, "fsync", 1, 0, 0, scm_fsync);
-SCM
-scm_fsync (SCM object)
+GUILE_PROC (scm_fsync, "fsync", 1, 0, 0,
+ (SCM object),
+"")
+#define FUNC_NAME s_scm_fsync
{
int fdes;
@@ -972,95 +952,90 @@ scm_fsync (SCM object)
}
else
{
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fsync);
+ SCM_VALIDATE_INT(1,object);
fdes = SCM_INUM (object);
}
if (fsync (fdes) == -1)
- scm_syserror (s_fsync);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_symlink, "symlink", 2, 0, 0, scm_symlink);
-
-SCM
-scm_symlink(oldpath, newpath)
- SCM oldpath;
- SCM newpath;
+GUILE_PROC (scm_symlink, "symlink", 2, 0, 0,
+ (SCM oldpath, SCM newpath),
+"")
+#define FUNC_NAME s_scm_symlink
{
#ifdef HAVE_SYMLINK
int val;
- SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1,
- s_symlink);
- SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2,
- s_symlink);
+ SCM_VALIDATE_ROSTRING(1,oldpath);
+ SCM_VALIDATE_ROSTRING(2,newpath);
SCM_COERCE_SUBSTR (oldpath);
SCM_COERCE_SUBSTR (newpath);
SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
if (val != 0)
- scm_syserror (s_symlink);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_symlink);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_readlink, "readlink", 1, 0, 0, scm_readlink);
-
-SCM
-scm_readlink(path)
- SCM path;
+GUILE_PROC (scm_readlink, "readlink", 1, 0, 0,
+ (SCM path),
+"")
+#define FUNC_NAME s_scm_readlink
{
#ifdef HAVE_READLINK
int rv;
int size = 100;
char *buf;
SCM result;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, (char *) SCM_ARG1,
- s_readlink);
+ SCM_VALIDATE_ROSTRING(1,path);
SCM_COERCE_SUBSTR (path);
- buf = scm_must_malloc (size, s_readlink);
+ buf = scm_must_malloc (size, FUNC_NAME);
while ((rv = readlink (SCM_ROCHARS (path), buf, size)) == size)
{
scm_must_free (buf);
size *= 2;
- buf = scm_must_malloc (size, s_readlink);
+ buf = scm_must_malloc (size, FUNC_NAME);
}
if (rv == -1)
- scm_syserror (s_readlink);
+ SCM_SYSERROR;
result = scm_makfromstr (buf, rv, 0);
scm_must_free (buf);
return result;
#else
- scm_sysmissing (s_readlink);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_lstat, "lstat", 1, 0, 0, scm_lstat);
-
-SCM
-scm_lstat(str)
- SCM str;
+GUILE_PROC (scm_lstat, "lstat", 1, 0, 0,
+ (SCM str),
+"")
+#define FUNC_NAME s_scm_lstat
{
#ifdef HAVE_LSTAT
int rv;
struct stat stat_temp;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
- s_lstat);
+ SCM_VALIDATE_ROSTRING(1,str);
SCM_COERCE_SUBSTR (str);
SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
if (rv != 0)
{
int en = errno;
- scm_syserror_msg (s_lstat, "%s: %S",
+ scm_syserror_msg (FUNC_NAME, "%s: %S",
scm_listify (scm_makfrom0str (strerror (errno)),
str,
SCM_UNDEFINED),
@@ -1068,72 +1043,69 @@ scm_lstat(str)
}
return scm_stat2scm(&stat_temp);
#else
- scm_sysmissing (s_lstat);
+ SCM_SYSMISSING;
/* not reached. */
return SCM_BOOL_F;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_copy_file, "copy-file", 2, 0, 0, scm_copy_file);
-
-SCM
-scm_copy_file (oldfile, newfile)
- SCM oldfile;
- SCM newfile;
+GUILE_PROC (scm_copy_file, "copy-file", 2, 0, 0,
+ (SCM oldfile, SCM newfile),
+"")
+#define FUNC_NAME s_scm_copy_file
{
int oldfd, newfd;
int n;
char buf[BUFSIZ];
struct stat oldstat;
- SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_copy_file);
+ SCM_VALIDATE_ROSTRING(1,oldfile);
if (SCM_SUBSTRP (oldfile))
oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile), 0);
- SCM_ASSERT (SCM_NIMP (newfile) && SCM_ROSTRINGP (newfile), newfile, SCM_ARG2, s_copy_file);
+ SCM_VALIDATE_ROSTRING(2,newfile);
if (SCM_SUBSTRP (newfile))
newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0);
if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
- scm_syserror (s_copy_file);
+ SCM_SYSERROR;
oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
if (oldfd == -1)
- scm_syserror (s_copy_file);
+ SCM_SYSERROR;
/* use POSIX flags instead of 07777?. */
newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
oldstat.st_mode & 07777);
if (newfd == -1)
- scm_syserror (s_copy_file);
+ SCM_SYSERROR;
while ((n = read (oldfd, buf, sizeof buf)) > 0)
if (write (newfd, buf, n) != n)
{
close (oldfd);
close (newfd);
- scm_syserror (s_copy_file);
+ SCM_SYSERROR;
}
close (oldfd);
if (close (newfd) == -1)
- scm_syserror (s_copy_file);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
/* Filename manipulation */
SCM scm_dot_string;
-SCM_PROC (s_dirname, "dirname", 1, 0, 0, scm_dirname);
-
-SCM
-scm_dirname (SCM filename)
+GUILE_PROC (scm_dirname, "dirname", 1, 0, 0,
+ (SCM filename),
+"")
+#define FUNC_NAME s_scm_dirname
{
char *s;
int i, len;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename),
- filename,
- SCM_ARG1,
- s_dirname);
+ SCM_VALIDATE_ROSTRING(1,filename);
s = SCM_ROCHARS (filename);
len = SCM_LENGTH (filename);
i = len - 1;
@@ -1150,23 +1122,21 @@ scm_dirname (SCM filename)
else
return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (i + 1));
}
+#undef FUNC_NAME
-SCM_PROC (s_basename, "basename", 1, 1, 0, scm_basename);
-
-SCM
-scm_basename (SCM filename, SCM suffix)
+GUILE_PROC (scm_basename, "basename", 1, 1, 0,
+ (SCM filename, SCM suffix),
+"")
+#define FUNC_NAME s_scm_basename
{
char *f, *s = 0;
int i, j, len, end;
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename),
- filename,
- SCM_ARG1,
- s_basename);
+ SCM_VALIDATE_ROSTRING(1,filename);
SCM_ASSERT (SCM_UNBNDP (suffix)
|| (SCM_NIMP (suffix) && SCM_ROSTRINGP (suffix)),
suffix,
SCM_ARG2,
- s_basename);
+ FUNC_NAME);
f = SCM_ROCHARS (filename);
if (SCM_UNBNDP (suffix))
j = -1;
@@ -1195,6 +1165,7 @@ scm_basename (SCM filename, SCM suffix)
SCM_MAKINUM (i + 1),
SCM_MAKINUM (end + 1));
}
+#undef FUNC_NAME