-/* Copyright (C) 1996, 1997, 1998 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
* 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 */
+
\f
#include <stdio.h>
-#include "_scm.h"
-#include "genio.h"
-#include "smob.h"
-#include "feature.h"
-#include "fports.h"
-#include "iselect.h"
-
-#include "filesys.h"
+#include <errno.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/validate.h"
+#include "libguile/filesys.h"
+
\f
+#ifdef HAVE_IO_H
+#include <io.h>
+#endif
+
#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
/* {Permissions}
*/
-SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
-
-SCM
-scm_chown (object, owner, group)
- SCM object;
- SCM owner;
- SCM group;
+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"
+ "the integer values @var{owner} and @var{group}. @var{object} can be\n"
+ "a string containing a file name or, if the platform\n"
+ "supports fchown, a port or integer file descriptor\n"
+ "which is open on the file. The return value\n"
+ "is unspecified.\n\n"
+ "If @var{object} is a symbolic link, either the\n"
+ "ownership of the link or the ownership of the referenced file will be\n"
+ "changed depending on the operating system (lchown is\n"
+ "unsupported at present). If @var{owner} or @var{group} is specified\n"
+ "as @code{-1}, then that ID is not changed.")
+#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_DEFER_INTS;
- if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
+ SCM_VALIDATE_INUM (2,owner);
+ SCM_VALIDATE_INUM (3,group);
+#ifdef HAVE_FCHOWN
+ if (SCM_INUMP (object) || (SCM_OPFPORTP (object)))
{
- if (SCM_INUMP (object))
- fdes = SCM_INUM (object);
- else
- {
- fdes = fileno ((FILE *) SCM_STREAM (object));
- if (fdes == -1)
- scm_syserror (s_chown);
- }
+ int fdes = SCM_INUMP (object) ? SCM_INUM (object)
+ : SCM_FPORT_FDES (object);
+
SCM_SYSCALL (rv = fchown (fdes, SCM_INUM (owner), SCM_INUM (group)));
}
else
+#endif
{
- SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_chown);
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
+ 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)));
}
if (rv == -1)
- scm_syserror (s_chown);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
-
-
-SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
-
-SCM
-scm_chmod (object, mode)
- SCM object;
- SCM mode;
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
+ (SCM object, SCM mode),
+ "Changes the permissions of the file referred to 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{fchmod} is used\n"
+ "as the underlying system call).\n"
+ "@var{mode} specifies\n"
+ "the new permissions as a decimal number, e.g., @code{(chmod \"foo\" #o755)}.\n"
+ "The return value is unspecified.")
+#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_DEFER_INTS;
- if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
+ SCM_VALIDATE_INUM (2,mode);
+ if (SCM_INUMP (object) || SCM_OPFPORTP (object))
{
if (SCM_INUMP (object))
fdes = SCM_INUM (object);
else
- {
- fdes = fileno ((FILE *) SCM_STREAM (object));
- if (fdes == -1)
- scm_syserror (s_chmod);
- }
+ fdes = SCM_FPORT_FDES (object);
SCM_SYSCALL (rv = fchmod (fdes, SCM_INUM (mode)));
}
else
{
- SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_chmod);
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
+ 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)
- scm_syserror (s_chmod);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
-
-SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask);
-
-SCM
-scm_umask (mode)
- SCM mode;
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
+ (SCM mode),
+ "If @var{mode} is omitted, retuns 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.")
+#define FUNC_NAME s_scm_umask
{
mode_t mask;
if (SCM_UNBNDP (mode))
}
else
{
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG1, s_umask);
+ SCM_VALIDATE_INUM (1,mode);
mask = umask (SCM_INUM (mode));
}
return SCM_MAKINUM (mask);
}
+#undef FUNC_NAME
\f
-SCM_PROC (s_open_fdes, "open-fdes", 2, 1, 0, scm_open_fdes);
-SCM
-scm_open_fdes (SCM path, SCM flags, SCM mode)
+SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
+ (SCM path, SCM flags, SCM mode),
+ "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_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_open_fdes);
- SCM_COERCE_SUBSTR (path);
- iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
-
- SCM_DEFER_INTS;
- if (SCM_UNBNDP (mode))
- imode = 0666;
- else
- {
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open_fdes);
- imode = SCM_INUM (mode);
- }
- SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
+ SCM_VALIDATE_STRING (1, path);
+ SCM_STRING_COERCE_0TERMINATION_X (path);
+ iflags = SCM_NUM2LONG(2,flags);
+ imode = SCM_NUM2LONG_DEF(3,mode,0666);
+ SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1)
- scm_syserror (s_open_fdes);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_MAKINUM (fd);
}
-
-SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
-SCM
-scm_open (SCM path, SCM flags, SCM mode)
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_open, "open", 2, 1, 0,
+ (SCM path, SCM flags, SCM mode),
+ "Open the file named by @var{path} for reading and/or writing.\n"
+ "@var{flags} is an integer specifying how the file should be opened.\n"
+ "@var{mode} is an integer specifying the permission bits of the file, if\n"
+ "it needs to be created, before the umask is applied. The default is 666\n"
+ "(Unix itself has no default).\n\n"
+ "@var{flags} can be constructed by combining variables using @code{logior}.\n"
+ "Basic flags are:\n\n"
+ "@defvar O_RDONLY\n"
+ "Open the file read-only.\n"
+ "@end defvar\n"
+ "@defvar O_WRONLY\n"
+ "Open the file write-only. \n"
+ "@end defvar\n"
+ "@defvar O_RDWR\n"
+ "Open the file read/write.\n"
+ "@end defvar\n"
+ "@defvar O_APPEND\n"
+ "Append to the file instead of truncating.\n"
+ "@end defvar\n"
+ "@defvar O_CREAT\n"
+ "Create the file if it does not already exist.\n"
+ "@end defvar\n\n"
+ "See the Unix documentation of the @code{open} system call\n"
+ "for additional flags.")
+#define FUNC_NAME s_scm_open
{
SCM newpt;
char *port_mode;
int fd;
- FILE *f;
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
- iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
+ iflags = SCM_NUM2LONG (2,flags);
if (iflags & O_RDWR)
- port_mode = "r+";
+ {
+ if (iflags & O_APPEND)
+ port_mode = "a+";
+ else if (iflags & O_CREAT)
+ port_mode = "w+";
+ else
+ port_mode = "r+";
+ }
else {
- if (iflags & O_WRONLY)
+ if (iflags & O_APPEND)
+ port_mode = "a";
+ else if (iflags & O_WRONLY)
port_mode = "w";
else
port_mode = "r";
}
- SCM_DEFER_INTS;
- f = fdopen (fd, port_mode);
- if (!f)
- {
- SCM_SYSCALL (close (fd));
- scm_syserror (s_open);
- }
- newpt = scm_stdio_to_port (f, port_mode, path);
- SCM_ALLOW_INTS;
-
+ newpt = scm_fdes_to_port (fd, port_mode, path);
return newpt;
}
-
-SCM_PROC (s_close, "close", 1, 0, 0, scm_close);
-SCM
-scm_close (SCM fd_or_port)
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_close, "close", 1, 0, 0,
+ (SCM fd_or_port),
+ "Similar to close-port (@pxref{Generic Port Operations, 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"
+ "their revealed counts set to zero.")
+#define FUNC_NAME s_scm_close
{
int rv;
int fd;
fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
- if (SCM_NIMP (fd_or_port) && SCM_PORTP (fd_or_port))
+ if (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_INUM (1,fd_or_port);
fd = SCM_INUM (fd_or_port);
- SCM_DEFER_INTS;
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);
- SCM_ALLOW_INTS;
- return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
+ SCM_SYSERROR;
+ return SCM_NEGATE_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
\f
/* {Files}
SCM_SYMBOL (scm_sym_regular, "regular");
SCM_SYMBOL (scm_sym_directory, "directory");
+#ifdef HAVE_S_ISLNK
SCM_SYMBOL (scm_sym_symlink, "symlink");
+#endif
SCM_SYMBOL (scm_sym_block_special, "block-special");
SCM_SYMBOL (scm_sym_char_special, "char-special");
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 ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
ve[13] = scm_sym_regular;
else if (S_ISDIR (mode))
ve[13] = scm_sym_directory;
+#ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode))
ve[13] = scm_sym_symlink;
+#endif
else if (S_ISBLK (mode))
ve[13] = scm_sym_block_special;
else if (S_ISCHR (mode))
ve[13] = scm_sym_char_special;
else if (S_ISFIFO (mode))
ve[13] = scm_sym_fifo;
+#ifdef S_ISSOCK
else if (S_ISSOCK (mode))
ve[13] = scm_sym_sock;
+#endif
else
ve[13] = scm_sym_unknown;
return ans;
}
-SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
-
-SCM
-scm_stat (object)
- SCM object;
+SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
+ (SCM object),
+ "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\n"
+ "other files on the same device.\n"
+ "@item stat:mode\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"
+ "The user ID of the file's owner.\n"
+ "@item stat:gid\n"
+ "The group ID of the file.\n"
+ "@item stat:rdev\n"
+ "Device ID; this entry is defined only for character or block\n"
+ "special files.\n"
+ "@item stat:size\n"
+ "The size of a regular file in bytes.\n"
+ "@item stat:atime\n"
+ "The last access time for the file.\n"
+ "@item stat:mtime\n"
+ "The last modification time for the file.\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\n"
+ "bytes.\n"
+ "@item stat:blocks\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"
+ "@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, fifo,\n"
+ "socket and unknown\n"
+ "@item stat:perms\n"
+ "An integer representing the access permission bits.\n"
+ "@end table")
+#define FUNC_NAME s_scm_stat
{
int rv;
int fdes;
struct stat stat_temp;
- SCM_DEFER_INTS;
if (SCM_INUMP (object))
SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp));
else
{
- SCM_ASSERT (SCM_NIMP (object), object, SCM_ARG1, s_stat);
- if (SCM_ROSTRINGP (object))
+ SCM_VALIDATE_NIM (1,object);
+ if (SCM_STRINGP (object))
{
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp));
+ SCM_STRING_COERCE_0TERMINATION_X (object);
+ SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp));
}
else
{
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_OPFPORTP (object), object, SCM_ARG1, s_stat);
- fdes = fileno ((FILE *) SCM_STREAM (object));
- if (fdes == -1)
- scm_syserror (s_stat);
+ SCM_VALIDATE_OPFPORT(1,object);
+ fdes = SCM_FPORT_FDES (object);
SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
}
}
{
int en = errno;
- scm_syserror_msg (s_stat, "%s: %S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- object,
- SCM_UNDEFINED),
+ SCM_SYSERROR_MSG ("~A: ~S",
+ SCM_LIST2 (scm_makfrom0str (strerror (errno)), object),
en);
}
- SCM_ALLOW_INTS;
return scm_stat2scm (&stat_temp);
}
+#undef FUNC_NAME
\f
/* {Modifying Directories}
*/
-SCM_PROC (s_link, "link", 2, 0, 0, scm_link);
-
-SCM
-scm_link (oldpath, newpath)
- SCM oldpath;
- SCM newpath;
+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"
+ "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_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath,
- SCM_ARG1, s_link);
- 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);
- if (SCM_SUBSTRP (newpath))
- newpath = scm_makfromstr (SCM_ROCHARS (newpath),
- SCM_ROLENGTH (newpath), 0);
- SCM_DEFER_INTS;
- SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
+ 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)
- scm_syserror (s_link);
- SCM_ALLOW_INTS;
+ 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;
+SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
+ (SCM oldname, SCM newname),
+ "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_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_COERCE_SUBSTR (oldname);
- SCM_COERCE_SUBSTR (newname);
- SCM_DEFER_INTS;
+ 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_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)
- scm_syserror (s_rename);
- SCM_ALLOW_INTS;
+ 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;
+SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
+ (SCM str),
+ "Deletes (or \"unlinks\") the file specified by @var{path}.")
+#define FUNC_NAME s_scm_delete_file
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1,
- s_delete_file);
- SCM_COERCE_SUBSTR (str);
- SCM_DEFER_INTS;
- SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
+ SCM_VALIDATE_STRING (1, str);
+ SCM_STRING_COERCE_0TERMINATION_X (str);
+ SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str)));
if (ans != 0)
- scm_syserror (s_delete_file);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_truncate_file, "truncate-file", 2, 0, 0, scm_truncate_file);
-SCM
-scm_truncate_file (SCM object, SCM size)
-{
- int rv;
- scm_sizet csize;
- int fdes;
-
- object = SCM_COERCE_OUTPORT (object);
-
- csize = (scm_sizet) scm_num2long (size, (char *) SCM_ARG2, s_truncate_file);
- SCM_DEFER_INTS;
- if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
- {
- if (SCM_INUMP (object))
- fdes = SCM_INUM (object);
- else
- {
- fdes = fileno ((FILE *) SCM_STREAM (object));
- if (fdes == -1)
- scm_syserror (s_truncate_file);
- }
- SCM_SYSCALL (rv = ftruncate (fdes, csize));
- }
- else
- {
- SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_chown);
- SCM_COERCE_SUBSTR (object);
- SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), csize));
- }
- if (rv == -1)
- scm_syserror (s_truncate_file);
- SCM_ALLOW_INTS;
- return SCM_UNSPECIFIED;
-}
-
-SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
-
-SCM
-scm_mkdir (path, mode)
- SCM path;
- SCM mode;
-{
#ifdef HAVE_MKDIR
+SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
+ (SCM path, SCM mode),
+ "Create a new directory named by @var{path}. If @var{mode} is omitted\n"
+ "then the permissions of the directory file are set using the current\n"
+ "umask. Otherwise they are set to the decimal value specified with\n"
+ "@var{mode}. The return value is unspecified.")
+#define FUNC_NAME s_scm_mkdir
+{
int rv;
mode_t mask;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_mkdir);
- SCM_COERCE_SUBSTR (path);
- SCM_DEFER_INTS;
+ SCM_VALIDATE_STRING (1, path);
+ SCM_STRING_COERCE_0TERMINATION_X (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_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir);
- 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 (s_mkdir);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
-#else
- scm_sysmissing (s_mkdir);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
+#undef FUNC_NAME
+#endif /* HAVE_MKDIR */
-
-SCM_PROC (s_rmdir, "rmdir", 1, 0, 0, scm_rmdir);
-
-SCM
-scm_rmdir (path)
- SCM path;
-{
#ifdef HAVE_RMDIR
+SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
+ (SCM path),
+ "Remove the existing directory named by @var{path}. The directory must\n"
+ "be empty for this to succeed. The return value is unspecified.")
+#define FUNC_NAME s_scm_rmdir
+{
int val;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
- s_rmdir);
- SCM_COERCE_SUBSTR (path);
- SCM_DEFER_INTS;
- SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
+ SCM_VALIDATE_STRING (1, path);
+ SCM_STRING_COERCE_0TERMINATION_X (path);
+ SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path)));
if (val != 0)
- scm_syserror (s_rmdir);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
-#else
- scm_sysmissing (s_rmdir);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
+#undef FUNC_NAME
+#endif
\f
+
/* {Examining Directories}
*/
-long scm_tc16_dir;
+scm_bits_t scm_tc16_dir;
+
+
+SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
+ (SCM obj),
+ "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));
+}
+#undef FUNC_NAME
-SCM_PROC (s_opendir, "opendir", 1, 0, 0, scm_opendir);
-SCM
-scm_opendir (dirname)
- SCM dirname;
+SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
+ (SCM dirname),
+ "Open the directory specified by @var{path} and return a directory\n"
+ "stream.")
+#define FUNC_NAME s_scm_opendir
{
DIR *ds;
- SCM dir;
- SCM_ASSERT (SCM_NIMP (dirname) && SCM_ROSTRINGP (dirname), dirname, SCM_ARG1,
- s_opendir);
- SCM_COERCE_SUBSTR (dirname);
- SCM_NEWCELL (dir);
- SCM_DEFER_INTS;
- SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname)));
+ SCM_VALIDATE_STRING (1, dirname);
+ SCM_STRING_COERCE_0TERMINATION_X (dirname);
+ SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
if (ds == NULL)
- scm_syserror (s_opendir);
- SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN);
- SCM_SETCDR (dir, ds);
- SCM_ALLOW_INTS;
- return dir;
+ SCM_SYSERROR;
+ SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_DIR_FLAG_OPEN, ds);
}
+#undef FUNC_NAME
-SCM_PROC (s_readdir, "readdir", 1, 0, 0, scm_readdir);
-
-SCM
-scm_readdir (port)
- SCM port;
+SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
+ (SCM port),
+ "Return (as a string) the next directory entry from the directory stream\n"
+ "@var{stream}. If there is no remaining entry to be read then the\n"
+ "end of file object is returned.")
+#define FUNC_NAME s_scm_readdir
{
struct dirent *rdent;
- SCM_DEFER_INTS;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_readdir);
+
+ SCM_VALIDATE_DIR (1, port);
+ if (!SCM_DIR_OPEN_P (port))
+ SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+
errno = 0;
- SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
- SCM_ALLOW_INTS;
+ SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (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_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_DIR (1, port);
+ if (!SCM_DIR_OPEN_P (port))
+ SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
-SCM_PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
+ rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
-SCM
-scm_rewinddir (port)
- SCM port;
-{
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_rewinddir);
- 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;
+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_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_closedir);
- SCM_DEFER_INTS;
- if (SCM_CLOSEDP (port))
+ if (SCM_DIR_OPEN_P (port))
{
- SCM_ALLOW_INTS;
- return SCM_UNSPECIFIED;
- }
- SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
- if (sts != 0)
- scm_syserror (s_closedir);
- SCM_SETCAR (port, scm_tc16_dir);
- SCM_ALLOW_INTS;
- 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);
+ }
+ 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 (sexp, port, pstate)
- SCM sexp;
- SCM port;
- scm_print_state *pstate;
+scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
{
- scm_prinport (sexp, port, "directory");
+ scm_puts ("#<", port);
+ if (!SCM_DIR_OPEN_P (exp))
+ scm_puts ("closed: ", port);
+ scm_puts ("directory stream ", port);
+ scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
+ scm_putc ('>', port);
return 1;
}
-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));
+ if (SCM_DIR_OPEN_P (p))
+ closedir ((DIR *) SCM_CELL_WORD_1 (p));
return 0;
}
-static scm_smobfuns dir_smob = {0, scm_dir_free, scm_dir_print, 0};
-
\f
/* {Navigating Directories}
*/
-SCM_PROC (s_chdir, "chdir", 1, 0, 0, scm_chdir);
-
-SCM
-scm_chdir (str)
- SCM str;
+SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
+ (SCM str),
+ "Change the current working directory to @var{path}.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_chdir
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
- SCM_COERCE_SUBSTR (str);
- SCM_DEFER_INTS;
- SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
+ SCM_VALIDATE_STRING (1, str);
+ SCM_STRING_COERCE_0TERMINATION_X (str);
+ SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str)));
if (ans != 0)
- scm_syserror (s_chdir);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-
-
-SCM_PROC (s_getcwd, "getcwd", 0, 0, 0, scm_getcwd);
-
-SCM
-scm_getcwd ()
-{
#ifdef HAVE_GETCWD
+SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
+ (),
+ "Return the name of the current working directory.")
+#define FUNC_NAME s_scm_getcwd
+{
char *rv;
-
scm_sizet size = 100;
char *wd;
SCM result;
- SCM_DEFER_INTS;
- 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);
- SCM_ALLOW_INTS;
return result;
-#else
- scm_sysmissing (s_getcwd);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
+#undef FUNC_NAME
+#endif /* HAVE_GETCWD */
\f
-SCM_PROC (s_select, "select", 3, 2, 0, scm_select);
-
+#ifdef HAVE_SELECT
+/* check that element is a port or file descriptor. if it's a port
+ and its buffer is ready for use, add it to the ports_ready list.
+ otherwise add its file descriptor to *set. the type of list can be
+ determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes,
+ SCM_ARG3 for excepts. */
static int
-set_element (SELECT_TYPE *set, SCM element, int arg)
+set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos)
{
int fd;
- element = SCM_COERCE_OUTPORT (element);
- if (SCM_NIMP (element) && SCM_FPORTP (element) && SCM_OPPORTP (element))
- fd = fileno ((FILE *) SCM_STREAM (element));
- else {
- SCM_ASSERT (SCM_INUMP (element), element, arg, s_select);
- fd = SCM_INUM (element);
- }
- FD_SET (fd, set);
+
+ if (SCM_INUMP (element))
+ {
+ fd = SCM_INUM (element);
+ }
+ else
+ {
+ int use_buf = 0;
+
+ element = SCM_COERCE_OUTPORT (element);
+ SCM_ASSERT (SCM_OPFPORTP (element), element, pos, "select");
+ if (pos == SCM_ARG1)
+ {
+ /* check whether port has buffered input. */
+ scm_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);
+
+ /* > 1 since writing the last byte in the buffer causes flush. */
+ if (pt->write_end - pt->write_pos > 1)
+ use_buf = 1;
+ }
+ fd = use_buf ? -1 : SCM_FPORT_FDES (element);
+ }
+ if (fd == -1)
+ *ports_ready = scm_cons (element, *ports_ready);
+ else
+ FD_SET (fd, set);
return fd;
}
+/* check list_or_vec, a list or vector of ports or file descriptors,
+ adding each member to either the ports_ready list (if it's a port
+ with a usable buffer) or to *set. the kind of list_or_vec can be
+ determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes,
+ SCM_ARG3 for excepts. */
static int
-fill_select_type (SELECT_TYPE *set, SCM list, int arg)
+fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
{
- int max_fd = 0, fd;
- if (SCM_NIMP (list) && SCM_VECTORP (list))
+ int max_fd = 0;
+
+ if (SCM_VECTORP (list_or_vec))
{
- int len = SCM_LENGTH (list);
- SCM *ve = SCM_VELTS (list);
+ int i = SCM_VECTOR_LENGTH (list_or_vec);
+ SCM *ve = SCM_VELTS (list_or_vec);
- while (len > 0)
+ while (--i >= 0)
{
- fd = set_element (set, ve[len - 1], arg);
+ int fd = set_element (set, ports_ready, ve[i], pos);
+
if (fd > max_fd)
max_fd = fd;
- len--;
}
}
else
{
- while (list != SCM_EOL)
+ while (!SCM_NULLP (list_or_vec))
{
- fd = set_element (set, SCM_CAR (list), arg);
+ int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos);
+
if (fd > max_fd)
max_fd = fd;
- list = SCM_CDR (list);
+ list_or_vec = SCM_CDR (list_or_vec);
}
}
return max_fd;
}
+/* if element (a file descriptor or port) appears in *set, cons it to
+ list. return list. */
static SCM
get_element (SELECT_TYPE *set, SCM element, SCM list)
{
- element = SCM_COERCE_OUTPORT (element);
- if (SCM_NIMP (element) && SCM_FPORTP (element) && SCM_OPPORTP (element))
+ int fd;
+
+ if (SCM_INUMP (element))
{
- if (FD_ISSET (fileno ((FILE *)SCM_STREAM (element)), set))
- list = scm_cons (element, list);
+ fd = SCM_INUM (element);
}
- else if (SCM_INUMP (element))
+ else
{
- if (FD_ISSET (SCM_INUM (element), set))
- list = scm_cons (element, list);
+ fd = SCM_FPORT_FDES (SCM_COERCE_OUTPORT (element));
}
+ if (FD_ISSET (fd, set))
+ list = scm_cons (element, list);
return list;
}
+/* construct component of scm_select return value.
+ set: pointer to set of file descriptors found by select to be ready
+ ports_ready: ports ready due to buffering
+ list_or_vec: original list/vector handed to scm_select.
+ the return value is a list/vector of ready ports/file descriptors.
+ works by finding the objects in list which correspond to members of
+ *set and appending them to ports_ready. result is converted to a
+ vector if list_or_vec is a vector. */
static SCM
-retrieve_select_type (SELECT_TYPE *set, SCM list)
+retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
{
- SCM answer_list = SCM_EOL;
+ SCM answer_list = ports_ready;
- if (SCM_NIMP (list) && SCM_VECTORP (list))
+ if (SCM_VECTORP (list_or_vec))
{
- int len = SCM_LENGTH (list);
- SCM *ve = SCM_VELTS (list);
+ int i = SCM_VECTOR_LENGTH (list_or_vec);
+ SCM *ve = SCM_VELTS (list_or_vec);
- while (len > 0)
+ while (--i >= 0)
{
- answer_list = get_element (set, ve[len - 1], answer_list);
- len--;
+ answer_list = get_element (set, ve[i], answer_list);
}
return scm_vector (answer_list);
}
else
{
- /* list is a list. */
- while (list != SCM_EOL)
+ /* list_or_vec must be a list. */
+ while (!SCM_NULLP (list_or_vec))
{
- answer_list = get_element (set, SCM_CAR (list), answer_list);
- list = SCM_CDR (list);
+ answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list);
+ list_or_vec = SCM_CDR (list_or_vec);
}
return answer_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 */
+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"
+ "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"
+ "@var{reads}, @var{writes} and @var{excepts} can be lists or\n"
+ "vectors, with each member a port or a file descriptor.\n"
+ "The value returned is a list of three corresponding\n"
+ "lists or vectors containing only the members which meet the\n"
+ "specified requirement. The ability of port buffers to\n"
+ "provide input or accept output is taken into account.\n"
+ "Ordering of the input lists or vectors is not preserved.\n\n"
+ "The optional arguments @var{secs} and @var{usecs} specify the\n"
+ "timeout. Either @var{secs} can be specified alone, as\n"
+ "either an integer or a real number, or both @var{secs} and\n"
+ "@var{usecs} can be specified as integers, in which case\n"
+ "@var{usecs} is an additional timeout expressed in\n"
+ "microseconds. If @var{secs} is omitted or is @code{#f} then\n"
+ "select will wait for as long as it takes for one of the other\n"
+ "conditions to be satisfied.\n\n"
+ "The scsh version of @code{select} differs as follows:\n"
+ "Only vectors are accepted for the first three arguments.\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"
+ )
+#define FUNC_NAME s_scm_select
{
-#ifdef HAVE_SELECT
struct timeval timeout;
- struct timeval * time_p;
+ struct timeval * time_ptr;
SELECT_TYPE read_set;
SELECT_TYPE write_set;
SELECT_TYPE except_set;
- int max_fd, fd;
- int sreturn;
-
-#define assert_set(x, arg) \
- SCM_ASSERT (scm_ilength (x) > -1 || (SCM_NIMP (x) && SCM_VECTORP (x)), \
- x, arg, s_select)
- assert_set (reads, SCM_ARG1);
- assert_set (writes, SCM_ARG2);
- assert_set (excepts, SCM_ARG3);
-#undef assert_set
+ int read_count;
+ int write_count;
+ int except_count;
+ /* these lists accumulate ports which are ready due to buffering.
+ their file descriptors don't need to be added to the select sets. */
+ SCM read_ports_ready = SCM_EOL;
+ SCM write_ports_ready = SCM_EOL;
+ int max_fd;
+
+ if (SCM_VECTORP (reads))
+ {
+ read_count = SCM_VECTOR_LENGTH (reads);
+ }
+ else
+ {
+ read_count = scm_ilength (reads);
+ SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
+ }
+ if (SCM_VECTORP (writes))
+ {
+ write_count = SCM_VECTOR_LENGTH (writes);
+ }
+ else
+ {
+ write_count = scm_ilength (writes);
+ SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
+ }
+ if (SCM_VECTORP (excepts))
+ {
+ except_count = SCM_VECTOR_LENGTH (excepts);
+ }
+ else
+ {
+ except_count = scm_ilength (excepts);
+ SCM_ASSERT (except_count >= 0, excepts, SCM_ARG3, FUNC_NAME);
+ }
FD_ZERO (&read_set);
FD_ZERO (&write_set);
FD_ZERO (&except_set);
- max_fd = fill_select_type (&read_set, reads, SCM_ARG1);
- fd = fill_select_type (&write_set, writes, SCM_ARG2);
- if (fd > max_fd)
- max_fd = fd;
- fd = fill_select_type (&except_set, excepts, SCM_ARG3);
- if (fd > max_fd)
- max_fd = fd;
+ max_fd = fill_select_type (&read_set, &read_ports_ready, reads, SCM_ARG1);
+
+ {
+ int write_max = fill_select_type (&write_set, &write_ports_ready,
+ writes, SCM_ARG2);
+ int except_max = fill_select_type (&except_set, NULL,
+ excepts, SCM_ARG3);
+
+ if (write_max > max_fd)
+ max_fd = write_max;
+ if (except_max > max_fd)
+ max_fd = except_max;
+ }
- if (SCM_UNBNDP (secs) || SCM_FALSEP (secs))
- time_p = 0;
+ /* if there's a port with a ready buffer, don't block, just
+ check for ready file descriptors. */
+ if (!SCM_NULLP (read_ports_ready) || !SCM_NULLP (write_ports_ready))
+ {
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 0;
+ time_ptr = &timeout;
+ }
+ else if (SCM_UNBNDP (secs) || SCM_FALSEP (secs))
+ time_ptr = 0;
else
{
if (SCM_INUMP (secs))
timeout.tv_usec = 0;
else
{
- SCM_ASSERT (SCM_INUMP (usecs), usecs, SCM_ARG5, s_select);
-
+ SCM_VALIDATE_INUM (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 (4, secs);
if (fl > LONG_MAX)
- scm_out_of_range (s_select, secs);
+ SCM_OUT_OF_RANGE (4, secs);
timeout.tv_sec = (long) fl;
timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000);
}
- time_p = &timeout;
+ time_ptr = &timeout;
}
+ {
#ifdef GUILE_ISELECT
- sreturn = scm_internal_select (max_fd + 1,
- &read_set, &write_set, &except_set, time_p);
+ int rv = scm_internal_select (max_fd + 1,
+ &read_set, &write_set, &except_set,
+ time_ptr);
#else
- SCM_DEFER_INTS;
- sreturn = select (max_fd + 1,
- &read_set, &write_set, &except_set, time_p);
- SCM_ALLOW_INTS;
-#endif
- if (sreturn < 0)
- scm_syserror (s_select);
- 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);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
-}
-
-/* Check if FILE has characters waiting to be read. */
-
-#ifdef __IBMC__
-# define MSDOS
+ int rv = select (max_fd + 1,
+ &read_set, &write_set, &except_set, time_ptr);
#endif
-#ifdef MSDOS
-# ifndef GO32
-# include <io.h>
-# include <conio.h>
-
-int
-scm_input_waiting_p (f, caller)
- FILE *f;
- char *caller;
-{
- if (feof (f))
- return 1;
- if (fileno (f) == fileno (stdin) && (isatty (fileno (stdin))))
- return kbhit ();
- return -1;
-}
-
-# endif
-#else
-# ifdef _DCC
-# include <ioctl.h>
-# else
-# ifndef AMIGA
-# ifndef vms
-# ifdef MWC
-# include <sys/io.h>
-# else
-# ifndef THINK_C
-# ifndef ARM_ULIB
-# include <sys/ioctl.h>
-# endif
-# endif
-# endif
-# endif
-# endif
-# endif
-
-int
-scm_input_waiting_p (f, caller)
- FILE *f;
- char *caller;
-{
- /* Can we return an end-of-file character? */
- if (feof (f))
- return 1;
-
- /* Do we have characters in the stdio buffer? */
-# ifdef FILE_CNT_FIELD
- if (f->FILE_CNT_FIELD > 0)
- return 1;
-# else
-# ifdef FILE_CNT_GPTR
- if (f->_gptr != f->_egptr)
- return 1;
-# else
-# ifdef FILE_CNT_READPTR
- if (f->_IO_read_end != f->_IO_read_ptr)
- return 1;
-# else
- Configure.in could not guess the name of the correct field in a FILE *.
- This function needs to be ported to your system.
- It should return zero iff no characters are waiting to be read.;
-# endif
-# endif
-# endif
-
- /* Is the file prepared to deliver input? */
-# ifdef HAVE_SELECT
- {
- struct timeval timeout;
- SELECT_TYPE read_set;
- SELECT_TYPE write_set;
- SELECT_TYPE except_set;
- int fno = fileno ((FILE *)f);
-
- FD_ZERO (&read_set);
- FD_ZERO (&write_set);
- FD_ZERO (&except_set);
-
- FD_SET (fno, &read_set);
-
- timeout.tv_sec = 0;
- timeout.tv_usec = 0;
-
- SCM_DEFER_INTS;
- if (select (SELECT_SET_SIZE,
- &read_set, &write_set, &except_set, &timeout)
- < 0)
- scm_syserror (caller);
- SCM_ALLOW_INTS;
- return FD_ISSET (fno, &read_set);
+ if (rv < 0)
+ SCM_SYSERROR;
}
-# else
-# ifdef FIONREAD
- {
- long remir;
- ioctl(fileno(f), FIONREAD, &remir);
- return remir;
- }
-# else
- scm_misc_error ("char-ready?", "Not fully implemented on this platform",
- SCM_EOL);
-# endif
-# endif
+ 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));
}
-#endif
+#undef FUNC_NAME
+#endif /* HAVE_SELECT */
\f
-SCM_PROC (s_fcntl, "fcntl", 2, 0, 1, scm_fcntl);
-SCM
-scm_fcntl (SCM object, SCM cmd, SCM value)
+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"
+ "integer argument.\n\n"
+ "Values for @var{command} are:\n\n"
+ "@table @code\n"
+ "@item F_DUPFD\n"
+ "Duplicate a file descriptor\n"
+ "@item F_GETFD\n"
+ "Get flags associated with the file descriptor.\n"
+ "@item F_SETFD\n"
+ "Set flags associated with the file descriptor to @var{value}.\n"
+ "@item F_GETFL\n"
+ "Get flags associated with the open file.\n"
+ "@item F_SETFL\n"
+ "Set flags associated with the open file to @var{value}\n"
+ "@item F_GETOWN\n"
+ "Get the process ID of a socket's owner, for @code{SIGIO} signals.\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\n"
+ "@code{F_SETFL}.\n"
+ "@end table")
+#define FUNC_NAME s_scm_fcntl
{
int rv;
int fdes;
object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_INUMP (cmd), cmd, SCM_ARG2, s_fcntl);
- if (SCM_NIMP (object) && SCM_OPFPORTP (object))
- fdes = fileno ((FILE *) SCM_STREAM (object));
+ SCM_VALIDATE_INUM (2,cmd);
+ if (SCM_OPFPORTP (object))
+ fdes = SCM_FPORT_FDES (object);
else
{
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fcntl);
+ 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, s_fcntl);
- ivalue = SCM_INUM (SCM_CAR (value));
- }
- SCM_DEFER_INTS;
- if (fdes != -1)
- SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
- else
- rv = 0; /* avoid compiler warning. */
- if (rv == -1 || fdes == -1)
- scm_syserror (s_fcntl);
- SCM_ALLOW_INTS;
+ } 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);
}
-
-SCM_PROC (s_fsync, "fsync", 1, 0, 0, scm_fsync);
-SCM
-scm_fsync (SCM object)
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
+ (SCM object),
+ "Copies any unwritten data for the specified output file descriptor to disk.\n"
+ "If @var{port/fd} is a port, its buffer is flushed before the underlying\n"
+ "file descriptor is fsync'd.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_fsync
{
int fdes;
object = SCM_COERCE_OUTPORT (object);
- SCM_DEFER_INTS;
- if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+ if (SCM_OPFPORTP (object))
{
- scm_force_output (object);
- fdes = fileno ((FILE *) SCM_STREAM (object));
- if (fdes == -1)
- scm_syserror (s_fsync);
+ scm_flush (object);
+ fdes = SCM_FPORT_FDES (object);
}
else
{
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fsync);
+ SCM_VALIDATE_INUM (1,object);
fdes = SCM_INUM (object);
}
if (fsync (fdes) == -1)
- scm_syserror (s_fsync);
- SCM_ALLOW_INTS;
+ 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;
-{
#ifdef HAVE_SYMLINK
+SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
+ (SCM oldpath, SCM newpath),
+ "Create a symbolic link named @var{path-to} with the value (i.e., pointing to)\n"
+ "@var{path-from}. The return value is unspecified.")
+#define FUNC_NAME s_scm_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_COERCE_SUBSTR (oldpath);
- SCM_COERCE_SUBSTR (newpath);
- SCM_DEFER_INTS;
- SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
+ 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 (s_symlink);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
-#else
- scm_sysmissing (s_symlink);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
+#undef FUNC_NAME
+#endif /* HAVE_SYMLINK */
-
-SCM_PROC (s_readlink, "readlink", 1, 0, 0, scm_readlink);
-
-SCM
-scm_readlink(path)
- SCM path;
-{
#ifdef HAVE_READLINK
+SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
+ (SCM path),
+ "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_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, (char *) SCM_ARG1,
- s_readlink);
- SCM_COERCE_SUBSTR (path);
- SCM_DEFER_INTS;
- buf = scm_must_malloc (size, s_readlink);
- while ((rv = readlink (SCM_ROCHARS (path), buf, size)) == size)
+ 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)
{
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);
- SCM_ALLOW_INTS;
return result;
-#else
- scm_sysmissing (s_readlink);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
+#undef FUNC_NAME
+#endif /* HAVE_READLINK */
-
-SCM_PROC (s_lstat, "lstat", 1, 0, 0, scm_lstat);
-
-SCM
-scm_lstat(str)
- SCM str;
-{
#ifdef HAVE_LSTAT
+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"
+ "file it points to. @var{path} must be a string.")
+#define FUNC_NAME s_scm_lstat
+{
int rv;
struct stat stat_temp;
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
- s_lstat);
- SCM_COERCE_SUBSTR (str);
- SCM_DEFER_INTS;
- SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &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 (s_lstat, "%s: %S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- str,
- SCM_UNDEFINED),
+ SCM_SYSERROR_MSG ("~A: ~S",
+ SCM_LIST2 (scm_makfrom0str (strerror (errno)), str),
en);
}
- SCM_ALLOW_INTS;
return scm_stat2scm(&stat_temp);
-#else
- scm_sysmissing (s_lstat);
- /* not reached. */
- return SCM_BOOL_F;
-#endif
}
-
-
-SCM_PROC (s_copy_file, "copy-file", 2, 0, 0, scm_copy_file);
-
-SCM
-scm_copy_file (oldfile, newfile)
- SCM oldfile;
- SCM newfile;
+#undef FUNC_NAME
+#endif /* HAVE_LSTAT */
+
+SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
+ (SCM oldfile, SCM newfile),
+ "Copy the file specified by @var{path-from} to @var{path-to}.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_copy_file
{
int oldfd, newfd;
int n;
- char buf[BUFSIZ]; /* this space could be shared. */
+ char buf[BUFSIZ];
struct stat oldstat;
- SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_copy_file);
- 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);
- 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_DEFER_INTS;
- oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
+ 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);
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,
+ newfd = open (SCM_STRING_CHARS (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_ALLOW_INTS;
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
\f
/* Filename manipulation */
SCM scm_dot_string;
-SCM_PROC (s_dirname, "dirname", 1, 0, 0, scm_dirname);
-
-SCM
-scm_dirname (SCM filename)
+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_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename),
- filename,
- SCM_ARG1,
- s_dirname);
- 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;
while (i >= 0 && s[i] == '/') --i;
while (i >= 0 && s[i] != '/') --i;
if (i < 0)
{
if (len > 0 && s[0] == '/')
- return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
+ 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));
}
-
-SCM_PROC (s_basename, "basename", 1, 1, 0, scm_basename);
-
-SCM
-scm_basename (SCM filename, SCM suffix)
+#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 privided, 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_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename),
- filename,
- SCM_ARG1,
- s_basename);
- SCM_ASSERT (SCM_UNBNDP (suffix)
- || (SCM_NIMP (suffix) && SCM_ROSTRINGP (suffix)),
- suffix,
- SCM_ARG2,
- s_basename);
- 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;
while (i >= 0 && f[i] == '/') --i;
end = i;
if (i == end)
{
if (len > 0 && f[0] == '/')
- return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1));
+ 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_add_feature ("i/o-extensions");
-
- scm_tc16_dir = scm_newsmob (&dir_smob);
+ 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 ("."));
#endif
#ifdef FD_CLOEXEC
scm_sysintern ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
-#endif
+#endif
-#include "filesys.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/filesys.x"
+#endif
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/