-/* Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* 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 */
\f
#include <stdio.h>
-#include "_scm.h"
-#include "smob.h"
-#include "feature.h"
-#include "fports.h"
-#include "iselect.h"
-#include "strings.h"
-#include "vectors.h"
+#include <errno.h>
-#include "validate.h"
-#include "filesys.h"
+#include "libguile/_scm.h"
+#include "libguile/smob.h"
+#include "libguile/feature.h"
+#include "libguile/fports.h"
+#include "libguile/iselect.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+#include "libguile/lang.h"
+
+#include "libguile/validate.h"
+#include "libguile/filesys.h"
\f
#ifdef HAVE_IO_H
#include <io.h>
#endif
+#ifdef HAVE_DIRECT_H
+#include <direct.h>
+#endif
+
#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#include <sys/stat.h>
#include <fcntl.h>
+#ifdef HAVE_PWD_H
#include <pwd.h>
+#endif
-#if HAVE_DIRENT_H
+#if defined (__MINGW32__) || defined (_MSC_VER) || defined (__BORLANDC__)
+# include "win32-dirent.h"
+# define NAMLEN(dirent) strlen((dirent)->d_name)
+#elif HAVE_DIRENT_H
# include <dirent.h>
# define NAMLEN(dirent) strlen((dirent)->d_name)
#else
#if defined (S_IFSOCK) && ! defined (S_ISSOCK)
#define S_ISSOCK(mode) (((mode) & S_IFMT) == S_IFSOCK)
#endif
+
+/* The MinGW gcc does not define the S_ISSOCK macro. Any other native Windows
+ compiler like BorlandC or MSVC has none of these macros defined. */
+#ifdef __MINGW32__
+
+# ifdef _S_IFIFO
+# undef _S_IFIFO
+# endif
+# ifdef _S_IFCHR
+# undef _S_IFCHR
+# endif
+# ifdef _S_IFBLK
+# undef _S_IFBLK
+# endif
+# ifdef _S_IFDIR
+# undef _S_IFDIR
+# endif
+# ifdef _S_IFREG
+# undef _S_IFREG
+# endif
+# ifdef _S_IFSOCK
+# undef _S_IFSOCK
+# endif
+
+# define _S_IFIFO 0x1000 /* FIFO */
+# define _S_IFCHR 0x2000 /* Character */
+# define _S_IFBLK 0x3000 /* Block */
+# define _S_IFDIR 0x4000 /* Directory */
+# define _S_IFREG 0x8000 /* Regular */
+# define _S_IFSOCK 0xC000 /* Socket */
+
+# ifdef S_ISBLK
+# undef S_ISBLK
+# endif
+# ifdef S_ISFIFO
+# undef S_ISFIFO
+# endif
+# ifdef S_ISCHR
+# undef S_ISCHR
+# endif
+# ifdef S_ISDIR
+# undef S_ISDIR
+# endif
+# ifdef S_ISREG
+# undef S_ISREG
+# endif
+# ifdef S_ISSOCK
+# undef S_ISSOCK
+# endif
+
+# define S_ISBLK(mode) (((mode) & _S_IFMT) == _S_IFBLK)
+# define S_ISFIFO(mode) (((mode) & _S_IFMT) == _S_IFIFO)
+# define S_ISCHR(mode) (((mode) & _S_IFMT) == _S_IFCHR)
+# define S_ISDIR(mode) (((mode) & _S_IFMT) == _S_IFDIR)
+# define S_ISREG(mode) (((mode) & _S_IFMT) == _S_IFREG)
+# define S_ISSOCK(mode) (((mode) & _S_IFMT) == _S_IFSOCK)
+
+#endif /* __MINGW32__ */
+
+/* Some more definitions for the native Windows port. */
+#ifdef __MINGW32__
+# define mkdir(path, mode) mkdir (path)
+# define fsync(fd) _commit (fd)
+# define fchmod(fd, mode) (-1)
+#endif /* __MINGW32__ */
\f
/* {Permissions}
*/
+#ifdef HAVE_CHOWN
SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
(SCM object, SCM owner, SCM group),
"Change the ownership and group of the file referred to by @var{object} to\n"
object = SCM_COERCE_OUTPORT (object);
- SCM_VALIDATE_INUM (2,owner);
- SCM_VALIDATE_INUM (3,group);
+ SCM_VALIDATE_INUM (2, owner);
+ SCM_VALIDATE_INUM (3, group);
#ifdef HAVE_FCHOWN
if (SCM_INUMP (object) || (SCM_OPFPORTP (object)))
{
else
#endif
{
- SCM_VALIDATE_ROSTRING(1,object);
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
+ SCM_VALIDATE_STRING (1, object);
+ SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object),
SCM_INUM (owner), SCM_INUM (group)));
}
if (rv == -1)
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+#endif /* HAVE_CHOWN */
SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
object = SCM_COERCE_OUTPORT (object);
- SCM_VALIDATE_INUM (2,mode);
+ SCM_VALIDATE_INUM (2, mode);
if (SCM_INUMP (object) || SCM_OPFPORTP (object))
{
if (SCM_INUMP (object))
}
else
{
- SCM_VALIDATE_ROSTRING (1,object);
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
+ SCM_VALIDATE_STRING (1, object);
+ SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode)));
}
if (rv == -1)
SCM_SYSERROR;
SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
(SCM mode),
- "If @var{mode} is omitted, retuns a decimal number representing the current\n"
+ "If @var{mode} is omitted, returns a decimal number representing the current\n"
"file creation mask. Otherwise the file creation mask is set to\n"
"@var{mode} and the previous value is returned.\n\n"
"E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18.")
}
else
{
- SCM_VALIDATE_INUM (1,mode);
+ SCM_VALIDATE_INUM (1, mode);
mask = umask (SCM_INUM (mode));
}
return SCM_MAKINUM (mask);
SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
(SCM path, SCM flags, SCM mode),
- "Similar to @code{open} but returns a file descriptor instead of a\n"
- "port.")
+ "Similar to @code{open} but return a file descriptor instead of\n"
+ "a port.")
#define FUNC_NAME s_scm_open_fdes
{
int fd;
int iflags;
int imode;
- SCM_VALIDATE_ROSTRING (1,path);
- SCM_COERCE_SUBSTR (path);
- iflags = SCM_NUM2LONG(2,flags);
- imode = SCM_NUM2LONG_DEF(3,mode,0666);
- SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
+ SCM_VALIDATE_STRING (1, path);
+ iflags = SCM_NUM2INT (2, flags);
+ imode = SCM_NUM2INT_DEF (3, mode, 0666);
+ SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1)
SCM_SYSERROR;
return SCM_MAKINUM (fd);
"Open the file read-only.\n"
"@end defvar\n"
"@defvar O_WRONLY\n"
- "Open the file write-only. \n"
+ "Open the file write-only.\n"
"@end defvar\n"
"@defvar O_RDWR\n"
"Open the file read/write.\n"
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
- iflags = SCM_NUM2LONG (2,flags);
+ iflags = SCM_NUM2INT (2, flags);
if (iflags & O_RDWR)
{
if (iflags & O_APPEND)
SCM_DEFINE (scm_close, "close", 1, 0, 0,
(SCM fd_or_port),
- "Similar to close-port (@pxref{Generic Port Operations, close-port}),\n"
+ "Similar to close-port (@pxref{Closing, close-port}),\n"
"but also works on file descriptors. A side\n"
"effect of closing a file descriptor is that any ports using that file\n"
"descriptor are moved to a different file descriptor and have\n"
if (SCM_PORTP (fd_or_port))
return scm_close_port (fd_or_port);
- SCM_VALIDATE_INUM (1,fd_or_port);
+ SCM_VALIDATE_INUM (1, fd_or_port);
fd = SCM_INUM (fd_or_port);
scm_evict_ports (fd); /* see scsh manual. */
SCM_SYSCALL (rv = close (fd));
not an error. */
if (rv < 0 && errno != EBADF)
SCM_SYSERROR;
- return SCM_NEGATE_BOOL(rv < 0);
+ return SCM_BOOL (rv >= 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_close_fdes, "close-fdes", 1, 0, 0,
+ (SCM fd),
+ "A simple wrapper for the @code{close} system call.\n"
+ "Close file descriptor @var{fd}, which must be an integer.\n"
+ "Unlike close (@pxref{Ports and File Descriptors, close}),\n"
+ "the file descriptor will be closed even if a port is using it.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_close_fdes
+{
+ int c_fd;
+ int rv;
+
+ SCM_VALIDATE_INUM_COPY (1, fd, c_fd);
+ SCM_SYSCALL (rv = close (c_fd));
+ if (rv < 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
static SCM
scm_stat2scm (struct stat *stat_temp)
{
- SCM ans = scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED);
- SCM *ve = SCM_VELTS (ans);
+ SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
- ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
- ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
- ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
- ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
- ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
- ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
-#ifdef HAVE_ST_RDEV
- ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
+ SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) stat_temp->st_dev));
+ SCM_VECTOR_SET(ans, 1, scm_ulong2num ((unsigned long) stat_temp->st_ino));
+ SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) stat_temp->st_mode));
+ SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) stat_temp->st_nlink));
+ SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) stat_temp->st_uid));
+ SCM_VECTOR_SET(ans, 5, scm_ulong2num ((unsigned long) stat_temp->st_gid));
+#ifdef HAVE_STRUCT_STAT_ST_RDEV
+ SCM_VECTOR_SET(ans, 6, scm_ulong2num ((unsigned long) stat_temp->st_rdev));
#else
- ve[6] = SCM_BOOL_F;
+ SCM_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif
- ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
- ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
- ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
- ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
-#ifdef HAVE_ST_BLKSIZE
- ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
+ SCM_VECTOR_SET(ans, 7, scm_ulong2num ((unsigned long) stat_temp->st_size));
+ SCM_VECTOR_SET(ans, 8, scm_ulong2num ((unsigned long) stat_temp->st_atime));
+ SCM_VECTOR_SET(ans, 9, scm_ulong2num ((unsigned long) stat_temp->st_mtime));
+ SCM_VECTOR_SET(ans, 10, scm_ulong2num ((unsigned long) stat_temp->st_ctime));
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+ SCM_VECTOR_SET(ans, 11, scm_ulong2num ((unsigned long) stat_temp->st_blksize));
#else
- ve[11] = scm_ulong2num (4096L);
+ SCM_VECTOR_SET(ans, 11, scm_ulong2num (4096L));
#endif
-#ifdef HAVE_ST_BLOCKS
- ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+ SCM_VECTOR_SET(ans, 12, scm_ulong2num ((unsigned long) stat_temp->st_blocks));
#else
- ve[12] = SCM_BOOL_F;
+ SCM_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif
{
int mode = stat_temp->st_mode;
if (S_ISREG (mode))
- ve[13] = scm_sym_regular;
+ SCM_VECTOR_SET(ans, 13, scm_sym_regular);
else if (S_ISDIR (mode))
- ve[13] = scm_sym_directory;
+ SCM_VECTOR_SET(ans, 13, scm_sym_directory);
#ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode))
- ve[13] = scm_sym_symlink;
+ SCM_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif
else if (S_ISBLK (mode))
- ve[13] = scm_sym_block_special;
+ SCM_VECTOR_SET(ans, 13, scm_sym_block_special);
else if (S_ISCHR (mode))
- ve[13] = scm_sym_char_special;
+ SCM_VECTOR_SET(ans, 13, scm_sym_char_special);
else if (S_ISFIFO (mode))
- ve[13] = scm_sym_fifo;
+ SCM_VECTOR_SET(ans, 13, scm_sym_fifo);
+#ifdef S_ISSOCK
else if (S_ISSOCK (mode))
- ve[13] = scm_sym_sock;
+ SCM_VECTOR_SET(ans, 13, scm_sym_sock);
+#endif
else
- ve[13] = scm_sym_unknown;
+ SCM_VECTOR_SET(ans, 13, scm_sym_unknown);
- ve[14] = SCM_MAKINUM ((~S_IFMT) & mode);
+ SCM_VECTOR_SET(ans, 14, SCM_MAKINUM ((~S_IFMT) & mode));
/* the layout of the bits in ve[14] is intended to be portable.
If there are systems that don't follow the usual convention,
tmp <<= 1;
if (S_IXOTH & mode) tmp += 1;
- ve[14] = SCM_MAKINUM (tmp);
+ SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp));
*/
}
return ans;
}
+#ifdef __MINGW32__
+/*
+ * Try getting the appropiate stat buffer for a given file descriptor
+ * under Windows. It differentiates between file, pipe and socket
+ * descriptors.
+ */
+static int fstat_Win32 (int fdes, struct stat *buf)
+{
+ int error, optlen = sizeof (int);
+
+ memset (buf, 0, sizeof (struct stat));
+
+ /* Is this a socket ? */
+ if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0)
+ {
+ buf->st_mode = _S_IFSOCK | _S_IREAD | _S_IWRITE | _S_IEXEC;
+ buf->st_nlink = 1;
+ buf->st_atime = buf->st_ctime = buf->st_mtime = time (NULL);
+ return 0;
+ }
+ /* Maybe a regular file or pipe ? */
+ return fstat (fdes, buf);
+}
+#endif /* __MINGW32__ */
+
SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
(SCM object),
- "Returns an object containing various information\n"
- "about the file determined by @var{obj}.\n"
- "@var{obj} can be a string containing a file name or a port or integer file\n"
- "descriptor which is open on a file (in which case @code{fstat} is used\n"
- "as the underlying system call).\n\n"
- "The object returned by @code{stat} can be passed as a single parameter\n"
- "to the following procedures, all of which return integers:\n\n"
+ "Return an object containing various information about the file\n"
+ "determined by @var{obj}. @var{obj} can be a string containing\n"
+ "a file name or a port or integer file descriptor which is open\n"
+ "on a file (in which case @code{fstat} is used as the underlying\n"
+ "system call).\n"
+ "\n"
+ "The object returned by @code{stat} can be passed as a single\n"
+ "parameter to the following procedures, all of which return\n"
+ "integers:\n"
+ "\n"
"@table @code\n"
"@item stat:dev\n"
"The device containing the file.\n"
"@item stat:ino\n"
- "The file serial number, which distinguishes this file from all other\n"
- "files on the same device.\n"
+ "The file serial number, which distinguishes this file from all\n"
+ "other files on the same device.\n"
"@item stat:mode\n"
- "The mode of the file. This includes file type information\n"
- "and the file permission bits. See @code{stat:type} and @code{stat:perms}\n"
- "below.\n"
+ "The mode of the file. This includes file type information and\n"
+ "the file permission bits. See @code{stat:type} and\n"
+ "@code{stat:perms} below.\n"
"@item stat:nlink\n"
"The number of hard links to the file.\n"
"@item stat:uid\n"
"@item stat:ctime\n"
"The last modification time for the attributes of the file.\n"
"@item stat:blksize\n"
- "The optimal block size for reading or writing the file, in bytes.\n"
+ "The optimal block size for reading or writing the file, in\n"
+ "bytes.\n"
"@item stat:blocks\n"
- "The amount of disk space that the file occupies measured in units of\n"
- "512 byte blocks.\n"
- "@end table\n\n"
+ "The amount of disk space that the file occupies measured in\n"
+ "units of 512 byte blocks.\n"
+ "@end table\n"
+ "\n"
"In addition, the following procedures return the information\n"
- "from stat:mode in a more convenient form:\n\n"
+ "from stat:mode in a more convenient form:\n"
+ "\n"
"@table @code\n"
"@item stat:type\n"
"A symbol representing the type of file. Possible values are\n"
- "regular, directory, symlink, block-special, char-special,\n"
- "fifo, socket and unknown\n"
+ "regular, directory, symlink, block-special, char-special, fifo,\n"
+ "socket and unknown\n"
"@item stat:perms\n"
"An integer representing the access permission bits.\n"
"@end table")
struct stat stat_temp;
if (SCM_INUMP (object))
- SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp));
+ {
+#ifdef __MINGW32__
+ SCM_SYSCALL (rv = fstat_Win32 (SCM_INUM (object), &stat_temp));
+#else
+ SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp));
+#endif
+ }
+ else if (SCM_STRINGP (object))
+ {
+#ifdef __MINGW32__
+ char *p, *file = strdup (SCM_STRING_CHARS (object));
+ p = file + strlen (file) - 1;
+ while (p > file && (*p == '/' || *p == '\\'))
+ *p-- = '\0';
+ SCM_SYSCALL (rv = stat (file, &stat_temp));
+ free (file);
+#else
+ SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp));
+#endif
+ }
else
{
- SCM_VALIDATE_NIM (1,object);
- if (SCM_ROSTRINGP (object))
- {
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp));
- }
- else
- {
- object = SCM_COERCE_OUTPORT (object);
- SCM_VALIDATE_OPFPORT(1,object);
- fdes = SCM_FPORT_FDES (object);
- SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
- }
+ object = SCM_COERCE_OUTPORT (object);
+ SCM_VALIDATE_OPFPORT (1, object);
+ fdes = SCM_FPORT_FDES (object);
+#ifdef __MINGW32__
+ SCM_SYSCALL (rv = fstat_Win32 (fdes, &stat_temp));
+#else
+ SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
+#endif
}
+
if (rv == -1)
{
int en = errno;
SCM_SYSERROR_MSG ("~A: ~S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- object,
- SCM_UNDEFINED), en);
+ scm_list_2 (scm_makfrom0str (strerror (errno)),
+ object),
+ en);
}
return scm_stat2scm (&stat_temp);
}
/* {Modifying Directories}
*/
+#ifdef HAVE_LINK
SCM_DEFINE (scm_link, "link", 2, 0, 0,
(SCM oldpath, SCM newpath),
- "Creates a new name @var{path-to} in the file system for the file\n"
- "named by @var{path-from}. If @var{path-from} is a symbolic link, the\n"
- "link may or may not be followed depending on the system.")
+ "Creates a new name @var{newpath} in the file system for the\n"
+ "file named by @var{oldpath}. If @var{oldpath} is a symbolic\n"
+ "link, the link may or may not be followed depending on the\n"
+ "system.")
#define FUNC_NAME s_scm_link
{
int val;
- SCM_VALIDATE_ROSTRING (1,oldpath);
- if (SCM_SUBSTRP (oldpath))
- oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
- SCM_ROLENGTH (oldpath), 0);
- 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)));
+ SCM_VALIDATE_STRING (1, oldpath);
+ SCM_VALIDATE_STRING (2, newpath);
+ SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath),
+ SCM_STRING_CHARS (newpath)));
if (val != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+#endif /* HAVE_LINK */
SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
(SCM oldname, SCM newname),
- "Renames the file specified by @var{path-from} to @var{path-to}.\n"
+ "Renames the file specified by @var{oldname} to @var{newname}.\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_rename
{
int rv;
- SCM_VALIDATE_ROSTRING (1,oldname);
- SCM_VALIDATE_ROSTRING (2,newname);
- SCM_COERCE_SUBSTR (oldname);
- SCM_COERCE_SUBSTR (newname);
+ SCM_VALIDATE_STRING (1, oldname);
+ SCM_VALIDATE_STRING (2, newname);
#ifdef HAVE_RENAME
- SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
+ SCM_SYSCALL (rv = rename (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
#else
- SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
+ SCM_SYSCALL (rv = link (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
if (rv == 0)
{
- SCM_SYSCALL (rv = unlink (SCM_ROCHARS (oldname)));;
+ SCM_SYSCALL (rv = unlink (SCM_STRING_CHARS (oldname)));;
if (rv != 0)
/* unlink failed. remove new name */
- SCM_SYSCALL (unlink (SCM_ROCHARS (newname)));
+ SCM_SYSCALL (unlink (SCM_STRING_CHARS (newname)));
}
#endif
if (rv != 0)
#define FUNC_NAME s_scm_delete_file
{
int ans;
- SCM_VALIDATE_ROSTRING (1,str);
- SCM_COERCE_SUBSTR (str);
- SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
+ SCM_VALIDATE_STRING (1, str);
+ SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str)));
if (ans != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
{
int rv;
mode_t mask;
- SCM_VALIDATE_ROSTRING (1,path);
- SCM_COERCE_SUBSTR (path);
+ SCM_VALIDATE_STRING (1, path);
if (SCM_UNBNDP (mode))
{
mask = umask (0);
umask (mask);
- SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), 0777 ^ mask));
+ SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), 0777 ^ mask));
}
else
{
- SCM_VALIDATE_INUM (2,mode);
- SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), SCM_INUM (mode)));
+ SCM_VALIDATE_INUM (2, mode);
+ SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode)));
}
if (rv != 0)
SCM_SYSERROR;
{
int val;
- SCM_VALIDATE_ROSTRING (1,path);
- SCM_COERCE_SUBSTR (path);
- SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
+ SCM_VALIDATE_STRING (1, path);
+ SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path)));
if (val != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
#endif
\f
+
/* {Examining Directories}
*/
-long scm_tc16_dir;
+scm_t_bits scm_tc16_dir;
+
SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
(SCM obj),
- "Returns a boolean indicating whether @var{object} is a directory stream\n"
- "as returned by @code{opendir}.")
+ "Return a boolean indicating whether @var{object} is a directory\n"
+ "stream as returned by @code{opendir}.")
#define FUNC_NAME s_scm_directory_stream_p
{
- return SCM_BOOL(SCM_DIRP (obj));
+ return SCM_BOOL (SCM_DIRP (obj));
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
(SCM dirname),
"Open the directory specified by @var{path} and return a directory\n"
#define FUNC_NAME s_scm_opendir
{
DIR *ds;
- SCM_VALIDATE_ROSTRING (1,dirname);
- SCM_COERCE_SUBSTR (dirname);
- SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname)));
+ SCM_VALIDATE_STRING (1, dirname);
+ SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
if (ds == NULL)
SCM_SYSERROR;
- SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds);
+ SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_DIR_FLAG_OPEN, ds);
}
#undef FUNC_NAME
#define FUNC_NAME s_scm_readdir
{
struct dirent *rdent;
- SCM_VALIDATE_OPDIR (1,port);
+
+ SCM_VALIDATE_DIR (1, port);
+ if (!SCM_DIR_OPEN_P (port))
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
+
errno = 0;
- SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
+ SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
if (errno != 0)
SCM_SYSERROR;
- return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
+
+ return (rdent ? scm_mem2string (rdent->d_name, NAMLEN (rdent))
: SCM_EOF_VAL);
}
#undef FUNC_NAME
-
SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
(SCM port),
"Reset the directory port @var{stream} so that the next call to\n"
"@code{readdir} will return the first directory entry.")
#define FUNC_NAME s_scm_rewinddir
{
- SCM_VALIDATE_OPDIR (1,port);
- rewinddir ((DIR *) SCM_CDR (port));
+ SCM_VALIDATE_DIR (1, port);
+ if (!SCM_DIR_OPEN_P (port))
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
+
+ rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-
SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
(SCM port),
"Close the directory stream @var{stream}.\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_closedir
{
- int sts;
+ SCM_VALIDATE_DIR (1, port);
- SCM_VALIDATE_DIR (1,port);
- if (SCM_CLOSEDP (port))
+ if (SCM_DIR_OPEN_P (port))
{
- return SCM_UNSPECIFIED;
+ int sts;
+
+ SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
+ if (sts != 0)
+ SCM_SYSERROR;
+
+ SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
}
- SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
- if (sts != 0)
- SCM_SYSERROR;
- SCM_SETCAR (port, scm_tc16_dir);
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-
-
static int
-scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
+scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
scm_puts ("#<", port);
- if (SCM_CLOSEDP (exp))
+ if (!SCM_DIR_OPEN_P (exp))
scm_puts ("closed: ", port);
scm_puts ("directory stream ", port);
- scm_intprint ((int)SCM_CDR (exp), 16, port);
+ scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
scm_putc ('>', port);
return 1;
}
-static scm_sizet
+static size_t
scm_dir_free (SCM p)
{
- if (SCM_OPENP (p))
- closedir ((DIR *) SCM_CDR (p));
+ if (SCM_DIR_OPEN_P (p))
+ closedir ((DIR *) SCM_CELL_WORD_1 (p));
return 0;
}
{
int ans;
- SCM_VALIDATE_ROSTRING (1,str);
- SCM_COERCE_SUBSTR (str);
- SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
+ SCM_VALIDATE_STRING (1, str);
+ SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str)));
if (ans != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
#ifdef HAVE_GETCWD
SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
(),
- "Returns the name of the current working directory.")
+ "Return the name of the current working directory.")
#define FUNC_NAME s_scm_getcwd
{
char *rv;
- scm_sizet size = 100;
+ size_t size = 100;
char *wd;
SCM result;
- wd = scm_must_malloc (size, FUNC_NAME);
+ wd = scm_malloc (size);
while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
{
- scm_must_free (wd);
+ free (wd);
size *= 2;
- wd = scm_must_malloc (size, FUNC_NAME);
+ wd = scm_malloc (size);
}
if (rv == 0)
SCM_SYSERROR;
- result = scm_makfromstr (wd, strlen (wd), 0);
- scm_must_free (wd);
+ result = scm_mem2string (wd, strlen (wd));
+ free (wd);
return result;
}
#undef FUNC_NAME
if (pos == SCM_ARG1)
{
/* check whether port has buffered input. */
- scm_port *pt = SCM_PTAB_ENTRY (element);
+ scm_t_port *pt = SCM_PTAB_ENTRY (element);
if (pt->read_pos < pt->read_end)
use_buf = 1;
else if (pos == SCM_ARG2)
{
/* check whether port's output buffer has room. */
- scm_port *pt = SCM_PTAB_ENTRY (element);
+ scm_t_port *pt = SCM_PTAB_ENTRY (element);
/* > 1 since writing the last byte in the buffer causes flush. */
if (pt->write_end - pt->write_pos > 1)
if (SCM_VECTORP (list_or_vec))
{
- int i = SCM_LENGTH (list_or_vec);
- SCM *ve = SCM_VELTS (list_or_vec);
+ int i = SCM_VECTOR_LENGTH (list_or_vec);
+ SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0)
{
}
else
{
- while (list_or_vec != SCM_EOL)
+ while (!SCM_NULL_OR_NIL_P (list_or_vec))
{
int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos);
if (SCM_VECTORP (list_or_vec))
{
- int i = SCM_LENGTH (list_or_vec);
- SCM *ve = SCM_VELTS (list_or_vec);
+ int i = SCM_VECTOR_LENGTH (list_or_vec);
+ SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0)
{
else
{
/* list_or_vec must be a list. */
- while (list_or_vec != SCM_EOL)
+ while (!SCM_NULL_OR_NIL_P (list_or_vec))
{
answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list);
list_or_vec = SCM_CDR (list_or_vec);
SCM_DEFINE (scm_select, "select", 3, 2, 0,
(SCM reads, SCM writes, SCM excepts, SCM secs, SCM usecs),
"This procedure has a variety of uses: waiting for the ability\n"
- "to provide input, accept output, or the existance of\n"
+ "to provide input, accept output, or the existence of\n"
"exceptional conditions on a collection of ports or file\n"
"descriptors, or waiting for a timeout to occur.\n"
"It also returns if interrupted by a signal.\n\n"
"The @var{usecs} argument is not supported.\n"
"Multiple values are returned instead of a list.\n"
"Duplicates in the input vectors appear only once in output.\n"
- "An additional @code{select!} interface is provided.\n"
- )
+ "An additional @code{select!} interface is provided.")
#define FUNC_NAME s_scm_select
{
struct timeval timeout;
if (SCM_VECTORP (reads))
{
- read_count = SCM_LENGTH (reads);
+ read_count = SCM_VECTOR_LENGTH (reads);
}
else
{
}
if (SCM_VECTORP (writes))
{
- write_count = SCM_LENGTH (writes);
+ write_count = SCM_VECTOR_LENGTH (writes);
}
else
{
}
if (SCM_VECTORP (excepts))
{
- except_count = SCM_LENGTH (excepts);
+ except_count = SCM_VECTOR_LENGTH (excepts);
}
else
{
/* if there's a port with a ready buffer, don't block, just
check for ready file descriptors. */
- if (read_ports_ready != SCM_EOL || write_ports_ready != SCM_EOL)
+ if (!SCM_NULLP (read_ports_ready) || !SCM_NULLP (write_ports_ready))
{
timeout.tv_sec = 0;
timeout.tv_usec = 0;
timeout.tv_usec = 0;
else
{
- SCM_VALIDATE_INUM (5,usecs);
+ SCM_VALIDATE_INUM (5, usecs);
timeout.tv_usec = SCM_INUM (usecs);
}
}
if (rv < 0)
SCM_SYSERROR;
}
- return scm_listify (retrieve_select_type (&read_set, read_ports_ready,
- reads),
- retrieve_select_type (&write_set, write_ports_ready,
- writes),
- retrieve_select_type (&except_set, SCM_EOL, excepts),
- SCM_UNDEFINED);
+ return scm_list_3 (retrieve_select_type (&read_set, read_ports_ready, reads),
+ retrieve_select_type (&write_set, write_ports_ready, writes),
+ retrieve_select_type (&except_set, SCM_EOL, excepts));
}
#undef FUNC_NAME
#endif /* HAVE_SELECT */
\f
-SCM_DEFINE (scm_fcntl, "fcntl", 2, 0, 1,
+#ifdef HAVE_FCNTL
+SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
(SCM object, SCM cmd, SCM value),
"Apply @var{command} to the specified file descriptor or the underlying\n"
"file descriptor of the specified port. @var{value} is an optional\n"
"@item F_SETOWN\n"
"Set the process that owns a socket to @var{value}, for @code{SIGIO} signals.\n"
"@item FD_CLOEXEC\n"
- "The value used to indicate the \"close on exec\" flag with @code{F_GETFL} or"
- "@code{F_SETFL}."
+ "The value used to indicate the \"close on exec\" flag with @code{F_GETFL} or\n"
+ "@code{F_SETFL}.\n"
"@end table")
#define FUNC_NAME s_scm_fcntl
{
object = SCM_COERCE_OUTPORT (object);
- SCM_VALIDATE_INUM (2,cmd);
+ SCM_VALIDATE_INUM (2, cmd);
if (SCM_OPFPORTP (object))
fdes = SCM_FPORT_FDES (object);
else
{
- SCM_VALIDATE_INUM (1,object);
+ SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
- if (SCM_NULLP (value))
+
+ if (SCM_UNBNDP (value)) {
ivalue = 0;
- else
- {
- SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, FUNC_NAME);
- ivalue = SCM_INUM (SCM_CAR (value));
- }
+ } else {
+ SCM_VALIDATE_INUM_COPY (SCM_ARG3, value, ivalue);
+ }
+
SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
if (rv == -1)
SCM_SYSERROR;
return SCM_MAKINUM (rv);
}
#undef FUNC_NAME
+#endif /* HAVE_FCNTL */
SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
(SCM object),
}
else
{
- SCM_VALIDATE_INUM (1,object);
+ SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
if (fsync (fdes) == -1)
{
int val;
- 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)));
+ SCM_VALIDATE_STRING (1, oldpath);
+ SCM_VALIDATE_STRING (2, newpath);
+ SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath)));
if (val != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
#ifdef HAVE_READLINK
SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
(SCM path),
- "Returns the value of the symbolic link named by\n"
- "@var{path} (a string), i.e., the\n"
- "file that the link points to.")
+ "Return the value of the symbolic link named by @var{path} (a\n"
+ "string), i.e., the file that the link points to.")
#define FUNC_NAME s_scm_readlink
{
int rv;
int size = 100;
char *buf;
SCM result;
- SCM_VALIDATE_ROSTRING (1,path);
- SCM_COERCE_SUBSTR (path);
- buf = scm_must_malloc (size, FUNC_NAME);
- while ((rv = readlink (SCM_ROCHARS (path), buf, size)) == size)
+ SCM_VALIDATE_STRING (1, path);
+ buf = scm_malloc (size);
+ while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size)
{
- scm_must_free (buf);
+ free (buf);
size *= 2;
- buf = scm_must_malloc (size, FUNC_NAME);
+ buf = scm_malloc (size);
}
if (rv == -1)
SCM_SYSERROR;
- result = scm_makfromstr (buf, rv, 0);
- scm_must_free (buf);
+ result = scm_mem2string (buf, rv);
+ free (buf);
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
(SCM str),
"Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
- "it will return information about a symbolic link itself, not the \n"
+ "it will return information about a symbolic link itself, not the\n"
"file it points to. @var{path} must be a string.")
#define FUNC_NAME s_scm_lstat
{
int rv;
struct stat stat_temp;
- SCM_VALIDATE_ROSTRING (1,str);
- SCM_COERCE_SUBSTR (str);
- SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
+ SCM_VALIDATE_STRING (1, str);
+ SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp));
if (rv != 0)
{
int en = errno;
SCM_SYSERROR_MSG ("~A: ~S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- str,
- SCM_UNDEFINED), en);
+ scm_list_2 (scm_makfrom0str (strerror (errno)), str),
+ en);
}
return scm_stat2scm(&stat_temp);
}
char buf[BUFSIZ];
struct stat oldstat;
- SCM_VALIDATE_ROSTRING (1,oldfile);
- if (SCM_SUBSTRP (oldfile))
- oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile), 0);
- 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_VALIDATE_STRING (1, oldfile);
+ SCM_VALIDATE_STRING (2, newfile);
+ if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1)
SCM_SYSERROR;
- oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
+ oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY);
if (oldfd == -1)
SCM_SYSERROR;
/* use POSIX flags instead of 07777?. */
- newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
+ newfd = open (SCM_STRING_CHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
oldstat.st_mode & 07777);
if (newfd == -1)
SCM_SYSERROR;
SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
(SCM filename),
- "")
+ "Return the directory name component of the file name\n"
+ "@var{filename}. If @var{filename} does not contain a directory\n"
+ "component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname
{
char *s;
- int i, len;
- SCM_VALIDATE_ROSTRING (1,filename);
- s = SCM_ROCHARS (filename);
- len = SCM_LENGTH (filename);
+ long int i;
+ unsigned long int len;
+
+ SCM_VALIDATE_STRING (1, filename);
+
+ s = SCM_STRING_CHARS (filename);
+ len = SCM_STRING_LENGTH (filename);
+
i = len - 1;
+#ifdef __MINGW32__
+ while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+ while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
+ while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+#else
while (i >= 0 && s[i] == '/') --i;
while (i >= 0 && s[i] != '/') --i;
while (i >= 0 && s[i] == '/') --i;
+#endif /* ndef __MINGW32__ */
if (i < 0)
{
+#ifdef __MINGW32__
+ if (len > 0 && (s[0] == '/' || s[0] == '\\'))
+#else
if (len > 0 && s[0] == '/')
- return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
+#endif /* ndef __MINGW32__ */
+ return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
else
return scm_dot_string;
}
else
- return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (i + 1));
+ return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (i + 1));
}
#undef FUNC_NAME
SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
(SCM filename, SCM suffix),
- "")
+ "Return the base name of the file name @var{filename}. The\n"
+ "base name is the file name without any directory components.\n"
+ "If @var{suffix} is provided, and is equal to the end of\n"
+ "@var{basename}, it is removed also.")
#define FUNC_NAME s_scm_basename
{
char *f, *s = 0;
int i, j, len, end;
- SCM_VALIDATE_ROSTRING (1,filename);
- SCM_ASSERT (SCM_UNBNDP (suffix)
- || (SCM_ROSTRINGP (suffix)),
- suffix,
- SCM_ARG2,
- FUNC_NAME);
- f = SCM_ROCHARS (filename);
+
+ SCM_VALIDATE_STRING (1, filename);
+ f = SCM_STRING_CHARS (filename);
+ len = SCM_STRING_LENGTH (filename);
+
if (SCM_UNBNDP (suffix))
j = -1;
else
{
- s = SCM_ROCHARS (suffix);
- j = SCM_LENGTH (suffix) - 1;
+ SCM_VALIDATE_STRING (2, suffix);
+ s = SCM_STRING_CHARS (suffix);
+ j = SCM_STRING_LENGTH (suffix) - 1;
}
- len = SCM_LENGTH (filename);
i = len - 1;
+#ifdef __MINGW32__
+ while (i >= 0 && (f[i] == '/' || f[i] == '\\')) --i;
+#else
while (i >= 0 && f[i] == '/') --i;
+#endif /* ndef __MINGW32__ */
end = i;
while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j;
if (j == -1)
end = i;
+#ifdef __MINGW32__
+ while (i >= 0 && (f[i] != '/' || f[i] != '\\')) --i;
+#else
while (i >= 0 && f[i] != '/') --i;
+#endif /* ndef __MINGW32__ */
if (i == end)
{
+#ifdef __MINGW32__
+ if (len > 0 && (f[0] == '/' || f[i] == '\\'))
+#else
if (len > 0 && f[0] == '/')
- return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
+#endif /* ndef __MINGW32__ */
+ return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
else
return scm_dot_string;
}
else
- return scm_make_shared_substring (filename,
- SCM_MAKINUM (i + 1),
- SCM_MAKINUM (end + 1));
+ return scm_substring (filename, SCM_MAKINUM (i + 1), SCM_MAKINUM (end + 1));
}
#undef FUNC_NAME
void
scm_init_filesys ()
{
- scm_tc16_dir = scm_make_smob_type_mfpe ("directory", 0,
- NULL, scm_dir_free,scm_dir_print, NULL);
+ scm_tc16_dir = scm_make_smob_type ("directory", 0);
+ scm_set_smob_free (scm_tc16_dir, scm_dir_free);
+ scm_set_smob_print (scm_tc16_dir, scm_dir_print);
scm_dot_string = scm_permanent_object (scm_makfrom0str ("."));
#ifdef O_RDONLY
-scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY));
+ scm_c_define ("O_RDONLY", scm_long2num (O_RDONLY));
#endif
#ifdef O_WRONLY
-scm_sysintern ("O_WRONLY", scm_long2num (O_WRONLY));
+ scm_c_define ("O_WRONLY", scm_long2num (O_WRONLY));
#endif
#ifdef O_RDWR
-scm_sysintern ("O_RDWR", scm_long2num (O_RDWR));
+ scm_c_define ("O_RDWR", scm_long2num (O_RDWR));
#endif
#ifdef O_CREAT
-scm_sysintern ("O_CREAT", scm_long2num (O_CREAT));
+ scm_c_define ("O_CREAT", scm_long2num (O_CREAT));
#endif
#ifdef O_EXCL
-scm_sysintern ("O_EXCL", scm_long2num (O_EXCL));
+ scm_c_define ("O_EXCL", scm_long2num (O_EXCL));
#endif
#ifdef O_NOCTTY
-scm_sysintern ("O_NOCTTY", scm_long2num (O_NOCTTY));
+ scm_c_define ("O_NOCTTY", scm_long2num (O_NOCTTY));
#endif
#ifdef O_TRUNC
-scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
+ scm_c_define ("O_TRUNC", scm_long2num (O_TRUNC));
#endif
#ifdef O_APPEND
-scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
+ scm_c_define ("O_APPEND", scm_long2num (O_APPEND));
#endif
#ifdef O_NONBLOCK
-scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
+ scm_c_define ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
#endif
#ifdef O_NDELAY
-scm_sysintern ("O_NDELAY", scm_long2num (O_NDELAY));
+ scm_c_define ("O_NDELAY", scm_long2num (O_NDELAY));
#endif
#ifdef O_SYNC
-scm_sysintern ("O_SYNC", scm_long2num (O_SYNC));
+ scm_c_define ("O_SYNC", scm_long2num (O_SYNC));
#endif
#ifdef F_DUPFD
-scm_sysintern ("F_DUPFD", scm_long2num (F_DUPFD));
+ scm_c_define ("F_DUPFD", scm_long2num (F_DUPFD));
#endif
#ifdef F_GETFD
-scm_sysintern ("F_GETFD", scm_long2num (F_GETFD));
+ scm_c_define ("F_GETFD", scm_long2num (F_GETFD));
#endif
#ifdef F_SETFD
-scm_sysintern ("F_SETFD", scm_long2num (F_SETFD));
+ scm_c_define ("F_SETFD", scm_long2num (F_SETFD));
#endif
#ifdef F_GETFL
-scm_sysintern ("F_GETFL", scm_long2num (F_GETFL));
+ scm_c_define ("F_GETFL", scm_long2num (F_GETFL));
#endif
#ifdef F_SETFL
-scm_sysintern ("F_SETFL", scm_long2num (F_SETFL));
+ scm_c_define ("F_SETFL", scm_long2num (F_SETFL));
#endif
#ifdef F_GETOWN
-scm_sysintern ("F_GETOWN", scm_long2num (F_GETOWN));
+ scm_c_define ("F_GETOWN", scm_long2num (F_GETOWN));
#endif
#ifdef F_SETOWN
-scm_sysintern ("F_SETOWN", scm_long2num (F_SETOWN));
+ scm_c_define ("F_SETOWN", scm_long2num (F_SETOWN));
#endif
#ifdef FD_CLOEXEC
-scm_sysintern ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
+ scm_c_define ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
#endif
-#include "filesys.x"
+#include "libguile/filesys.x"
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff