-/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 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 <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"
#endif
{
SCM_VALIDATE_STRING (1, object);
- SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object),
SCM_INUM (owner), SCM_INUM (group)));
}
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+#endif /* HAVE_CHOWN */
SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
else
{
SCM_VALIDATE_STRING (1, object);
- SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode)));
}
if (rv == -1)
int imode;
SCM_VALIDATE_STRING (1, path);
- SCM_STRING_COERCE_0TERMINATION_X (path);
- iflags = SCM_NUM2LONG(2,flags);
- imode = SCM_NUM2LONG_DEF(3,mode,0666);
+ 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;
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)
not an error. */
if (rv < 0 && errno != EBADF)
SCM_SYSERROR;
- return SCM_NEGATE_BOOL(rv < 0);
+ return SCM_BOOL (rv >= 0);
}
#undef FUNC_NAME
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
+#ifdef HAVE_STRUCT_STAT_ST_RDEV
ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
#else
ve[6] = SCM_BOOL_F;
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
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
#else
ve[11] = scm_ulong2num (4096L);
#endif
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
#else
ve[12] = SCM_BOOL_F;
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),
"Return an object containing various information about the file\n"
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_STRINGP (object))
- {
- SCM_STRING_COERCE_0TERMINATION_X (object);
- SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (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_LIST2 (scm_makfrom0str (strerror (errno)), object),
+ 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{newpath} in the file system for the\n"
int val;
SCM_VALIDATE_STRING (1, oldpath);
- SCM_STRING_COERCE_0TERMINATION_X (oldpath);
SCM_VALIDATE_STRING (2, newpath);
- SCM_STRING_COERCE_0TERMINATION_X (newpath);
SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath),
SCM_STRING_CHARS (newpath)));
if (val != 0)
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+#endif /* HAVE_LINK */
int rv;
SCM_VALIDATE_STRING (1, oldname);
SCM_VALIDATE_STRING (2, newname);
- SCM_STRING_COERCE_0TERMINATION_X (oldname);
- SCM_STRING_COERCE_0TERMINATION_X (newname);
#ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
#else
{
int ans;
SCM_VALIDATE_STRING (1, str);
- SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str)));
if (ans != 0)
SCM_SYSERROR;
int rv;
mode_t mask;
SCM_VALIDATE_STRING (1, path);
- SCM_STRING_COERCE_0TERMINATION_X (path);
if (SCM_UNBNDP (mode))
{
mask = umask (0);
int val;
SCM_VALIDATE_STRING (1, path);
- SCM_STRING_COERCE_0TERMINATION_X (path);
SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path)));
if (val != 0)
SCM_SYSERROR;
/* {Examining Directories}
*/
-scm_bits_t scm_tc16_dir;
+scm_t_bits scm_tc16_dir;
SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
{
DIR *ds;
SCM_VALIDATE_STRING (1, dirname);
- SCM_STRING_COERCE_0TERMINATION_X (dirname);
SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
if (ds == NULL)
SCM_SYSERROR;
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
- SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
errno = 0;
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_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
- SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
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_DIR_OPEN_P (exp))
}
-static scm_sizet
+static size_t
scm_dir_free (SCM p)
{
if (SCM_DIR_OPEN_P (p))
int ans;
SCM_VALIDATE_STRING (1, str);
- SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str)));
if (ans != 0)
SCM_SYSERROR;
#define FUNC_NAME s_scm_getcwd
{
char *rv;
- scm_sizet size = 100;
+ size_t size = 100;
char *wd;
SCM result;
}
if (rv == 0)
SCM_SYSERROR;
- result = scm_makfromstr (wd, strlen (wd), 0);
+ result = scm_mem2string (wd, strlen (wd));
scm_must_free (wd);
return result;
}
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 (rv < 0)
SCM_SYSERROR;
}
- return SCM_LIST3 (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));
+ 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
+#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"
return SCM_MAKINUM (rv);
}
#undef FUNC_NAME
+#endif /* HAVE_FCNTL */
SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
(SCM object),
SCM_VALIDATE_STRING (1, oldpath);
SCM_VALIDATE_STRING (2, newpath);
- SCM_STRING_COERCE_0TERMINATION_X (oldpath);
- SCM_STRING_COERCE_0TERMINATION_X (newpath);
SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath)));
if (val != 0)
SCM_SYSERROR;
char *buf;
SCM result;
SCM_VALIDATE_STRING (1, path);
- SCM_STRING_COERCE_0TERMINATION_X (path);
buf = scm_must_malloc (size, FUNC_NAME);
while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size)
{
}
if (rv == -1)
SCM_SYSERROR;
- result = scm_makfromstr (buf, rv, 0);
+ result = scm_mem2string (buf, rv);
scm_must_free (buf);
return result;
}
struct stat stat_temp;
SCM_VALIDATE_STRING (1, str);
- SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp));
if (rv != 0)
{
int en = errno;
SCM_SYSERROR_MSG ("~A: ~S",
- SCM_LIST2 (scm_makfrom0str (strerror (errno)), str),
+ scm_list_2 (scm_makfrom0str (strerror (errno)), str),
en);
}
return scm_stat2scm(&stat_temp);
struct stat oldstat;
SCM_VALIDATE_STRING (1, oldfile);
- SCM_STRING_COERCE_0TERMINATION_X (oldfile);
SCM_VALIDATE_STRING (2, newfile);
- SCM_STRING_COERCE_0TERMINATION_X (newfile);
if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1)
SCM_SYSERROR;
oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY);
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] == '/')
+#endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
else
return scm_dot_string;
j = SCM_STRING_LENGTH (suffix) - 1;
}
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] == '/')
+#endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
else
return scm_dot_string;
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
#ifndef SCM_MAGIC_SNARFER
HCoop / bpt / guile.git / blobdiff