-/* Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004 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
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * 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. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
\f
+#define _GNU_SOURCE /* ask glibc for everything */
+#define _POSIX_C_SOURCE 199506L /* for readdir_r elsewhere */
+
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
#include <stdio.h>
#include <errno.h>
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)))
{
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_INUM (1,mode);
+ SCM_VALIDATE_INUM (1, mode);
mask = umask (SCM_INUM (mode));
}
return SCM_MAKINUM (mask);
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));
scm_stat2scm (struct stat *stat_temp)
{
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[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);
+ 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
- ve[6] = scm_ulong2num ((unsigned long) stat_temp->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);
+ 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
- ve[11] = scm_ulong2num ((unsigned long) stat_temp->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_STRUCT_STAT_ST_BLOCKS
- ve[12] = scm_ulong2num ((unsigned long) stat_temp->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));
*/
}
}
else
{
- SCM_VALIDATE_INUM (2,mode);
+ SCM_VALIDATE_INUM (2, mode);
SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode)));
}
if (rv != 0)
#undef FUNC_NAME
+/* FIXME: The glibc manual has a portability note that readdir_r may not
+ null-terminate its return string. The circumstances outlined for this
+ are not clear, nor is it clear what should be done about it. Lets worry
+ about this if/when someone can figure it out. */
+
SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
(SCM port),
"Return (as a string) the next directory entry from the directory stream\n"
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;
+ {
+#if HAVE_READDIR_R
+ /* On Solaris 2.7, struct dirent only contains "char d_name[1]" and one is
+ expected to provide a buffer of "sizeof(struct dirent) + NAME_MAX"
+ bytes. The glibc 2.3.2 manual notes this sort of thing too, and
+ advises "offsetof(struct dirent,d_name) + NAME_MAX + 1". Either should
+ suffice, we give both to be certain. */
+ union {
+ struct dirent ent;
+ char pad1 [sizeof(struct dirent) + NAME_MAX];
+ char pad2 [offsetof (struct dirent, d_name) + NAME_MAX + 1];
+ } u;
+ SCM_SYSCALL (readdir_r ((DIR *) SCM_CELL_WORD_1 (port), &u.ent, &rdent));
+#else
+ SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
+#endif
+ if (errno != 0)
+ SCM_SYSERROR;
- return (rdent ? scm_mem2string (rdent->d_name, NAMLEN (rdent))
- : SCM_EOF_VAL);
+ return (rdent ? scm_mem2string (rdent->d_name, NAMLEN (rdent))
+ : SCM_EOF_VAL);
+ }
}
#undef FUNC_NAME
wd = scm_malloc (size);
}
if (rv == 0)
- SCM_SYSERROR;
+ {
+ int save_errno = errno;
+ free (wd);
+ errno = save_errno;
+ SCM_SYSERROR;
+ }
result = scm_mem2string (wd, strlen (wd));
free (wd);
return result;
if (SCM_VECTORP (list_or_vec))
{
int i = SCM_VECTOR_LENGTH (list_or_vec);
- SCM *ve = SCM_VELTS (list_or_vec);
+ SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0)
{
if (SCM_VECTORP (list_or_vec))
{
int i = SCM_VECTOR_LENGTH (list_or_vec);
- SCM *ve = SCM_VELTS (list_or_vec);
+ SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0)
{
timeout.tv_usec = 0;
else
{
- SCM_VALIDATE_INUM (5,usecs);
+ SCM_VALIDATE_INUM (5, usecs);
timeout.tv_usec = SCM_INUM (usecs);
}
}
}
{
-#ifdef GUILE_ISELECT
int rv = scm_internal_select (max_fd + 1,
&read_set, &write_set, &except_set,
time_ptr);
-#else
- int rv = select (max_fd + 1,
- &read_set, &write_set, &except_set, time_ptr);
-#endif
if (rv < 0)
SCM_SYSERROR;
}
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);
}
}
else
{
- SCM_VALIDATE_INUM (1,object);
+ SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
if (fsync (fdes) == -1)
buf = scm_malloc (size);
}
if (rv == -1)
- SCM_SYSERROR;
+ {
+ int save_errno = errno;
+ free (buf);
+ errno = save_errno;
+ SCM_SYSERROR;
+ }
result = scm_mem2string (buf, rv);
free (buf);
return result;
long int i;
unsigned long int len;
- SCM_VALIDATE_STRING (1,filename);
+ SCM_VALIDATE_STRING (1, filename);
s = SCM_STRING_CHARS (filename);
len = SCM_STRING_LENGTH (filename);
char *f, *s = 0;
int i, j, len, end;
- SCM_VALIDATE_STRING (1,filename);
+ SCM_VALIDATE_STRING (1, filename);
f = SCM_STRING_CHARS (filename);
len = SCM_STRING_LENGTH (filename);
if (j == -1)
end = i;
#ifdef __MINGW32__
- while (i >= 0 && (f[i] != '/' || f[i] != '\\')) --i;
+ 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] == '\\'))
+ if (len > 0 && (f[0] == '/' || f[0] == '\\'))
#else
if (len > 0 && f[0] == '/')
#endif /* ndef __MINGW32__ */
HCoop / bpt / guile.git / blobdiff