summaryrefslogtreecommitdiff
path: root/libguile/filesys.c
diff options
context:
space:
mode:
authorGreg J. Badros <gjb@cs.washington.edu>1999-12-12 02:36:16 +0000
committerGreg J. Badros <gjb@cs.washington.edu>1999-12-12 02:36:16 +0000
commit1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11 (patch)
tree79120a96365e0fa3324174bfd08d731ca8311d64 /libguile/filesys.c
parent6e7069385db8cf96dfbe51cf65ace161942a32c9 (diff)
downloadguile-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/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