-/* Copyright (C) 1996 Free Software Foundation, Inc.
+/* Copyright (C) 1996, 1997 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 do not wish that, delete this exception notice.
*/
\f
+#include <stdio.h>
#include "_scm.h"
#include "genio.h"
#include "smob.h"
#include "feature.h"
+#include "fports.h"
#include "filesys.h"
\f
#include <unistd.h>
#endif
-#ifdef HAVE_LIBC_H
+#ifdef LIBC_H_WITH_UNISTD_H
#include <libc.h>
#endif
\f
-#ifdef O_CREAT
-SCM_CONST_LONG (scm_O_CREAT, "O_CREAT", O_CREAT);
-#endif
-
-#ifdef O_EXCL
-SCM_CONST_LONG (scm_O_EXCL, "O_EXCL", O_EXCL);
-#endif
-
-#ifdef O_NOCTTY
-SCM_CONST_LONG (scm_O_NOCTTY, "O_NOCTTY", O_NOCTTY);
-#endif
-
-#ifdef O_TRUNC
-SCM_CONST_LONG (scm_O_TRUNC, "O_TRUNC", O_TRUNC);
-#endif
-
-#ifdef O_APPEND
-SCM_CONST_LONG (scm_O_APPEND, "O_APPEND", O_APPEND);
-#endif
-
-#ifdef O_NONBLOCK
-SCM_CONST_LONG (scm_O_NONBLOCK, "O_NONBLOCK", O_NONBLOCK);
-#endif
-
-#ifdef O_NDELAY
-SCM_CONST_LONG (scm_O_NDELAY, "O_NDELAY", O_NDELAY);
-#endif
-
-#ifdef O_SYNC
-SCM_CONST_LONG (scm_O_SYNC, "O_SYNC", O_SYNC);
-#endif
-
-
\f
/* {Permissions}
*/
-SCM_PROC (s_sys_chown, "chown", 3, 0, 0, scm_sys_chown);
+SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
SCM
-scm_sys_chown (path, owner, group)
+scm_chown (path, owner, group)
SCM path;
SCM owner;
SCM group;
{
int val;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_chown);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_chown);
if (SCM_SUBSTRP (path))
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
- SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_sys_chown);
- SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_sys_chown);
+ SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown);
+ SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
SCM_SYSCALL (val = chown (SCM_ROCHARS (path),
SCM_INUM (owner), SCM_INUM (group)));
if (val != 0)
- scm_syserror (s_sys_chown);
+ scm_syserror (s_chown);
return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_chmod, "chmod", 2, 0, 0, scm_sys_chmod);
+SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
SCM
-scm_sys_chmod (port_or_path, mode)
+scm_chmod (port_or_path, mode)
SCM port_or_path;
SCM mode;
{
int rv;
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_chmod);
- SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
+ SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
+ SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
if (SCM_STRINGP (port_or_path))
SCM_SYSCALL (rv = chmod (SCM_CHARS (port_or_path), SCM_INUM (mode)));
else
{
- SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
+ SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
rv = fileno ((FILE *)SCM_STREAM (port_or_path));
if (rv != -1)
SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode)));
}
if (rv != 0)
- scm_syserror (s_sys_chmod);
+ scm_syserror (s_chmod);
return SCM_UNSPECIFIED;
}
}
\f
-/* {File Descriptors}
- */
-long scm_tc16_fd;
-
-
-static int scm_fd_print SCM_P ((SCM sexp, SCM port, scm_print_state *pstate));
-
-static int
-scm_fd_print (sexp, port, pstate)
- SCM sexp;
- SCM port;
- scm_print_state *pstate;
-{
- scm_gen_puts (scm_regular_string, "#<fd ", port);
- scm_intprint (SCM_CDR (sexp), 10, port);
- scm_gen_puts (scm_regular_string, ">", port);
- return 1;
-}
-
-
-static scm_sizet scm_fd_free SCM_P ((SCM p));
-
-static scm_sizet
-scm_fd_free (p)
- SCM p;
-{
- SCM flags;
-
- flags = SCM_FD_FLAGS (p);
- if ((scm_close_fd_on_gc & flags) && (scm_fd_is_open & flags))
- {
- SCM_SYSCALL( close (SCM_FD (p)) );
- }
- return 0;
-}
-
-static scm_smobfuns fd_smob = {scm_mark0, scm_fd_free, scm_fd_print, 0};
+SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
SCM
-scm_intern_fd (fd, flags)
- int fd;
- int flags;
-{
- SCM it;
- SCM_NEWCELL (it);
- SCM_REDEFER_INTS;
- SCM_SETCAR (it, (scm_tc16_fd | (flags << 16)));
- SCM_SETCDR (it, (SCM)fd);
- SCM_REALLOW_INTS;
- return it;
-}
-
-\f
-
-SCM_PROC (s_sys_open, "open", 3, 0, 0, scm_sys_open);
-
-SCM
-scm_sys_open (path, flags, mode)
+scm_open (path, flags, mode)
SCM path;
SCM flags;
SCM mode;
{
int fd;
- SCM sfd;
+ SCM newpt;
+ FILE *f;
+ char *port_mode;
+ int iflags;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_open);
- SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG2, s_sys_open);
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_sys_open);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_open);
+ iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open);
if (SCM_SUBSTRP (path))
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
SCM_DEFER_INTS;
- SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) );
- if (fd == -1)
- scm_syserror (s_sys_open);
- sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
- SCM_ALLOW_INTS;
-
- return scm_return_first (sfd, path);
-}
-
-
-SCM_PROC (s_sys_create, "create", 2, 0, 0, scm_sys_create);
-
-SCM
-scm_sys_create (path, mode)
- SCM path;
- SCM mode;
-{
- int fd;
- SCM sfd;
-
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_create);
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_create);
-
- if (SCM_SUBSTRP (path))
- path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
-
- SCM_DEFER_INTS;
- SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) );
- if (fd == -1)
- scm_syserror (s_sys_create);
- sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
- SCM_ALLOW_INTS;
-
- return scm_return_first (sfd, path);
-}
-
-
-SCM_PROC (s_sys_close, "close", 1, 0, 0, scm_sys_close);
-
-SCM
-scm_sys_close (sfd)
- SCM sfd;
-{
- int fd;
- int got;
- SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1, s_sys_close);
- fd = SCM_FD (sfd);
-
- SCM_DEFER_INTS;
- got = close (fd);
- SCM_SETCAR (sfd, scm_tc16_fd);
- SCM_ALLOW_INTS;
- if (got == -1)
- scm_syserror (s_sys_close);
- return SCM_UNSPECIFIED;
-}
-
-
-SCM_PROC (s_sys_write_fd, "write-fd", 2, 0, 0, scm_sys_write_fd);
-
-SCM
-scm_sys_write_fd (sfd, buf)
- SCM sfd;
- SCM buf;
-{
- SCM answer;
- int fd;
- size_t written;
- SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1, s_sys_write_fd);
- SCM_ASSERT (SCM_NIMP (buf) && SCM_ROSTRINGP (buf), buf, SCM_ARG2, s_sys_write_fd);
- fd = SCM_FD (sfd);
- SCM_DEFER_INTS;
- written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf));
- if (written == -1)
- scm_syserror (s_sys_write_fd);
- answer = scm_long2num (written);
- SCM_ALLOW_INTS;
- return scm_return_first (answer, buf);
-}
-
-
-SCM_PROC (s_sys_read_fd, "read-fd", 2, 2, 0, scm_sys_read_fd);
-
-SCM
-scm_sys_read_fd (sfd, buf, offset, length)
- SCM sfd;
- SCM buf;
- SCM offset;
- SCM length;
-{
- SCM answer;
- int fd;
- char * bytes;
- int off;
- int len;
- size_t got;
-
- SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1, s_sys_read_fd);
- fd = SCM_FD (sfd);
-
- SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_sys_read_fd);
- bytes = SCM_CHARS (buf);
-
- if (SCM_UNBNDP (offset))
- off = 0;
- else
- {
- SCM_ASSERT (SCM_INUMP (offset), offset, SCM_ARG3, s_sys_read_fd);
- off = SCM_INUM (offset);
- }
-
- if (SCM_UNBNDP (length))
- len = SCM_LENGTH (buf);
+ if (SCM_UNBNDP (mode))
+ SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags));
else
{
- SCM_ASSERT (SCM_INUMP (length), length, SCM_ARG3, s_sys_read_fd);
- len = SCM_INUM (length);
+ SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open);
+ SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, SCM_INUM (mode)));
}
-
- SCM_DEFER_INTS;
- got = read (fd, bytes + off, len);
- if (got == -1)
- scm_syserror (s_sys_read_fd);
- answer = scm_long2num (got);
- SCM_ALLOW_INTS;
- return scm_return_first (answer, buf);
-}
-
-SCM_PROC (s_sys_lseek, "lseek", 2, 1, 0, scm_sys_lseek);
-
-SCM
-scm_sys_lseek (sfd, offset, whence)
- SCM sfd;
- SCM offset;
- SCM whence;
-{
- SCM answer;
- int fd;
- long off;
- int wh;
- long got;
-
- SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1, s_sys_lseek);
- fd = SCM_FD (sfd);
-
- off = scm_num2long (offset, (char *)SCM_ARG2, s_sys_lseek);
- if (SCM_UNBNDP (whence))
- wh = SEEK_SET;
- else
+ if (fd == -1)
+ scm_syserror (s_open);
+ SCM_NEWCELL (newpt);
+ if (iflags & O_RDWR)
+ port_mode = "r+";
+ else {
+ if (iflags & O_WRONLY)
+ port_mode = "w";
+ else
+ port_mode = "r";
+ }
+ f = fdopen (fd, port_mode);
+ if (!f)
{
- SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_sys_lseek);
- wh = SCM_INUM (whence);
+ SCM_SYSCALL (close (fd));
+ scm_syserror (s_open);
}
-
- SCM_DEFER_INTS;
- SCM_SYSCALL (got = lseek (fd, off, wh));
- if (got == -1)
- scm_syserror (s_sys_lseek);
- answer = scm_long2num (got);
+ {
+ struct scm_port_table * pt;
+
+ pt = scm_add_to_port_table (newpt);
+ SCM_SETPTAB_ENTRY (newpt, pt);
+ SCM_SETCAR (newpt, scm_tc16_fport | scm_mode_bits (port_mode));
+ /* if (SCM_BUF0 & SCM_CAR (newpt))
+ scm_setbuf0 (newpt); */
+ SCM_SETSTREAM (newpt, (SCM)f);
+ SCM_PTAB_ENTRY (newpt)->file_name = path;
+ }
SCM_ALLOW_INTS;
- return answer;
-}
-
-
-SCM_PROC (s_sys_dup, "dup", 1, 1, 0, scm_sys_dup);
-SCM
-scm_sys_dup (oldfd, newfd)
- SCM oldfd;
- SCM newfd;
-{
- SCM answer;
- int fd;
- int nfd;
- int (*fn)();
-
- SCM_ASSERT (SCM_NIMP (oldfd) && SCM_FD_P (oldfd), oldfd, SCM_ARG1, s_sys_dup);
- SCM_ASSERT (SCM_UNBNDP (newfd) || SCM_INUMP (newfd), newfd, SCM_ARG2, s_sys_dup);
- fd = SCM_FD (oldfd);
- nfd = (SCM_INUMP (newfd) ? SCM_INUM (newfd) : -1);
-
- SCM_DEFER_INTS;
- fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2);
- nfd = fn (fd, nfd);
- if (nfd == -1)
- scm_syserror (s_sys_dup);
- answer = SCM_MAKINUM (nfd);
- SCM_ALLOW_INTS;
- return answer;
+ return newpt;
}
-
\f
/* {Files}
*/
return ans;
}
-SCM_PROC (s_sys_stat, "stat", 1, 0, 0, scm_sys_stat);
+SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
SCM
-scm_sys_stat (fd_or_path)
+scm_stat (fd_or_path)
SCM fd_or_path;
{
int rv = 1;
rv = SCM_INUM (fd_or_path);
SCM_SYSCALL (rv = fstat (rv, &stat_temp));
}
- else if (SCM_NIMP (fd_or_path) && SCM_FD_P (fd_or_path))
- {
- rv = SCM_FD (fd_or_path);
- SCM_SYSCALL (rv = fstat (rv, &stat_temp));
- }
else
{
- SCM_ASSERT (SCM_NIMP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
- SCM_ASSERT (SCM_ROSTRINGP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
+ SCM_ASSERT (SCM_NIMP (fd_or_path), fd_or_path, SCM_ARG1, s_stat);
+ SCM_ASSERT (SCM_ROSTRINGP (fd_or_path), fd_or_path, SCM_ARG1, s_stat);
if (SCM_ROSTRINGP (fd_or_path))
{
if (SCM_SUBSTRP (fd_or_path))
}
if (rv != 0)
- scm_syserror_msg (s_sys_stat, "%s: %S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- fd_or_path,
- SCM_UNDEFINED));
+ {
+ int en = errno;
+
+ scm_syserror_msg (s_stat, "%s: %S",
+ scm_listify (scm_makfrom0str (strerror (errno)),
+ fd_or_path,
+ SCM_UNDEFINED),
+ en);
+ }
return scm_stat2scm (&stat_temp);
}
/* {Modifying Directories}
*/
-SCM_PROC (s_sys_link, "link", 2, 0, 0, scm_sys_link);
+SCM_PROC (s_link, "link", 2, 0, 0, scm_link);
SCM
-scm_sys_link (oldpath, newpath)
+scm_link (oldpath, newpath)
SCM oldpath;
SCM newpath;
{
int val;
- SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1, s_sys_link);
+ 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_sys_link);
+ 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_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0)
- scm_syserror (s_sys_link);
+ scm_syserror (s_link);
return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_rename, "rename-file", 2, 0, 0, scm_sys_rename);
+SCM_PROC (s_rename, "rename-file", 2, 0, 0, scm_rename);
SCM
-scm_sys_rename (oldname, newname)
+scm_rename (oldname, newname)
SCM oldname;
SCM newname;
{
int rv;
- SCM_ASSERT (SCM_NIMP (oldname) && SCM_STRINGP (oldname), oldname, SCM_ARG1, s_sys_rename);
- SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_sys_rename);
+ SCM_ASSERT (SCM_NIMP (oldname) && SCM_STRINGP (oldname), oldname, SCM_ARG1, s_rename);
+ SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_rename);
#ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname)));
if (rv != 0)
- scm_syserror (s_sys_rename);
+ scm_syserror (s_rename);
return SCM_UNSPECIFIED;
#else
SCM_DEFER_INTS;
}
SCM_ALLOW_INTS;
if (rv != 0)
- scm_syserror (s_sys_rename);
+ scm_syserror (s_rename);
return SCM_UNSPECIFIED;
#endif
}
-SCM_PROC(s_sys_delete_file, "delete-file", 1, 0, 0, scm_sys_delete_file);
+SCM_PROC(s_delete_file, "delete-file", 1, 0, 0, scm_delete_file);
SCM
-scm_sys_delete_file (str)
+scm_delete_file (str)
SCM str;
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_delete_file);
+ SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_delete_file);
SCM_SYSCALL (ans = unlink (SCM_CHARS (str)));
if (ans != 0)
- scm_syserror (s_sys_delete_file);
+ scm_syserror (s_delete_file);
return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_mkdir, "mkdir", 1, 1, 0, scm_sys_mkdir);
+SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
SCM
-scm_sys_mkdir (path, mode)
+scm_mkdir (path, mode)
SCM path;
SCM mode;
{
#ifdef HAVE_MKDIR
int rv;
mode_t mask;
- SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_mkdir);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_mkdir);
if (SCM_UNBNDP (mode))
{
mask = umask (0);
}
else
{
- SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_mkdir);
+ SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir);
SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode)));
}
if (rv != 0)
- scm_syserror (s_sys_mkdir);
+ scm_syserror (s_mkdir);
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_sys_mkdir);
+ scm_sysmissing (s_mkdir);
/* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_rmdir, "rmdir", 1, 0, 0, scm_sys_rmdir);
+SCM_PROC (s_rmdir, "rmdir", 1, 0, 0, scm_rmdir);
SCM
-scm_sys_rmdir (path)
+scm_rmdir (path)
SCM path;
{
#ifdef HAVE_RMDIR
int val;
- SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_rmdir);
SCM_SYSCALL (val = rmdir (SCM_CHARS (path)));
if (val != 0)
- scm_syserror (s_sys_rmdir);
+ scm_syserror (s_rmdir);
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_sys_rmdir);
+ scm_sysmissing (s_rmdir);
/* not reached. */
return SCM_BOOL_F;
#endif
long scm_tc16_dir;
-SCM_PROC (s_sys_opendir, "opendir", 1, 0, 0, scm_sys_opendir);
+SCM_PROC (s_opendir, "opendir", 1, 0, 0, scm_opendir);
SCM
-scm_sys_opendir (dirname)
+scm_opendir (dirname)
SCM dirname;
{
DIR *ds;
SCM dir;
- SCM_ASSERT (SCM_NIMP (dirname) && SCM_STRINGP (dirname), dirname, SCM_ARG1, s_sys_opendir);
+ SCM_ASSERT (SCM_NIMP (dirname) && SCM_STRINGP (dirname), dirname, SCM_ARG1, s_opendir);
SCM_NEWCELL (dir);
SCM_DEFER_INTS;
SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname)));
if (ds == NULL)
- scm_syserror (s_sys_opendir);
+ scm_syserror (s_opendir);
SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN);
SCM_SETCDR (dir, ds);
SCM_ALLOW_INTS;
}
-SCM_PROC (s_sys_readdir, "readdir", 1, 0, 0, scm_sys_readdir);
+SCM_PROC (s_readdir, "readdir", 1, 0, 0, scm_readdir);
SCM
-scm_sys_readdir (port)
+scm_readdir (port)
SCM port;
{
struct dirent *rdent;
SCM_DEFER_INTS;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_sys_readdir);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_readdir);
errno = 0;
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
SCM_ALLOW_INTS;
if (errno != 0)
- scm_syserror (s_sys_readdir);
+ scm_syserror (s_readdir);
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
: SCM_EOF_VAL);
}
-SCM_PROC (s_sys_closedir, "closedir", 1, 0, 0, scm_sys_closedir);
+SCM_PROC (s_closedir, "closedir", 1, 0, 0, scm_closedir);
SCM
-scm_sys_closedir (port)
+scm_closedir (port)
SCM port;
{
int sts;
- SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_sys_closedir);
+ SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_closedir);
SCM_DEFER_INTS;
if (SCM_CLOSEDP (port))
{
}
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
if (sts != 0)
- scm_syserror (s_sys_closedir);
+ scm_syserror (s_closedir);
SCM_SETCAR (port, scm_tc16_dir);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
*/
-SCM_PROC (s_sys_chdir, "chdir", 1, 0, 0, scm_sys_chdir);
+SCM_PROC (s_chdir, "chdir", 1, 0, 0, scm_chdir);
SCM
-scm_sys_chdir (str)
+scm_chdir (str)
SCM str;
{
int ans;
- SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir);
+ SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_chdir);
SCM_SYSCALL (ans = chdir (SCM_CHARS (str)));
if (ans != 0)
- scm_syserror (s_sys_chdir);
+ scm_syserror (s_chdir);
return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_getcwd, "getcwd", 0, 0, 0, scm_sys_getcwd);
+SCM_PROC (s_getcwd, "getcwd", 0, 0, 0, scm_getcwd);
SCM
-scm_sys_getcwd ()
+scm_getcwd ()
{
#ifdef HAVE_GETCWD
char *rv;
SCM result;
SCM_DEFER_INTS;
- wd = scm_must_malloc (size, s_sys_getcwd);
+ wd = scm_must_malloc (size, s_getcwd);
while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
{
scm_must_free (wd);
size *= 2;
- wd = scm_must_malloc (size, s_sys_getcwd);
+ wd = scm_must_malloc (size, s_getcwd);
}
if (rv == 0)
- scm_syserror (s_sys_getcwd);
+ scm_syserror (s_getcwd);
result = scm_makfromstr (wd, strlen (wd), 0);
scm_must_free (wd);
SCM_ALLOW_INTS;
return result;
#else
- scm_sysmissing (s_sys_getcwd);
+ scm_sysmissing (s_getcwd);
/* not reached. */
return SCM_BOOL_F;
#endif
FD_SET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list))), set);
else if (SCM_INUMP (SCM_CAR (list)))
FD_SET (SCM_INUM (SCM_CAR (list)), set);
- else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
- FD_SET (SCM_FD (SCM_CAR (list)), set);
list = SCM_CDR (list);
}
}
if (FD_ISSET (SCM_INUM (SCM_CAR (list)), set))
answer = scm_cons (SCM_CAR (list), answer);
}
- else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
- {
- if (FD_ISSET (SCM_FD (SCM_CAR (list)), set))
- answer = scm_cons (SCM_CAR (list), answer);
- }
list = SCM_CDR (list);
}
return answer;
}
-SCM_PROC (s_sys_select, "select", 3, 2, 0, scm_sys_select);
+/* {Checking for events}
+ */
+
+SCM_PROC (s_select, "select", 3, 2, 0, scm_select);
SCM
-scm_sys_select (reads, writes, excepts, secs, msecs)
+scm_select (reads, writes, excepts, secs, msecs)
SCM reads;
SCM writes;
SCM excepts;
SELECT_TYPE except_set;
int sreturn;
- SCM_ASSERT (-1 < scm_ilength (reads), reads, SCM_ARG1, s_sys_select);
- SCM_ASSERT (-1 < scm_ilength (writes), reads, SCM_ARG1, s_sys_select);
- SCM_ASSERT (-1 < scm_ilength (excepts), reads, SCM_ARG1, s_sys_select);
+ SCM_ASSERT (-1 < scm_ilength (reads), reads, SCM_ARG1, s_select);
+ SCM_ASSERT (-1 < scm_ilength (writes), reads, SCM_ARG1, s_select);
+ SCM_ASSERT (-1 < scm_ilength (excepts), reads, SCM_ARG1, s_select);
FD_ZERO (&read_set);
FD_ZERO (&write_set);
time_p = 0;
else
{
- SCM_ASSERT (SCM_INUMP (secs), secs, SCM_ARG4, s_sys_select);
+ SCM_ASSERT (SCM_INUMP (secs), secs, SCM_ARG4, s_select);
if (SCM_UNBNDP (msecs))
msecs = SCM_INUM0;
else
- SCM_ASSERT (SCM_INUMP (msecs), msecs, SCM_ARG5, s_sys_select);
+ SCM_ASSERT (SCM_INUMP (msecs), msecs, SCM_ARG5, s_select);
timeout.tv_sec = SCM_INUM (secs);
timeout.tv_usec = 1000 * SCM_INUM (msecs);
sreturn = select (SELECT_SET_SIZE,
&read_set, &write_set, &except_set, time_p);
if (sreturn < 0)
- scm_syserror (s_sys_select);
+ scm_syserror (s_select);
SCM_ALLOW_INTS;
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_sys_select);
+ scm_sysmissing (s_select);
/* not reached. */
return SCM_BOOL_F;
#endif
}
+/* Check if FILE has characters waiting to be read. */
+
+#ifdef __IBMC__
+# define MSDOS
+#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);
+ }
+# else
+# ifdef FIONREAD
+ {
+ long remir;
+ ioctl(fileno(f), FIONREAD, &remir);
+ return remir;
+ }
+# else
+ scm_misc_error ("char-ready?", "Not fully implemented\n");
+# endif
+# endif
+}
+#endif
+
\f
/* {Symbolic Links}
*/
-SCM_PROC (s_sys_symlink, "symlink", 2, 0, 0, scm_sys_symlink);
+SCM_PROC (s_symlink, "symlink", 2, 0, 0, scm_symlink);
SCM
-scm_sys_symlink(oldpath, newpath)
+scm_symlink(oldpath, newpath)
SCM oldpath;
SCM newpath;
{
#ifdef HAVE_SYMLINK
int val;
- SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, s_sys_symlink);
- SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_sys_symlink);
+ SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, s_symlink);
+ SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_symlink);
SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath)));
if (val != 0)
- scm_syserror (s_sys_symlink);
+ scm_syserror (s_symlink);
return SCM_UNSPECIFIED;
#else
- scm_sysmissing (s_sys_symlink);
+ scm_sysmissing (s_symlink);
/* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_readlink, "readlink", 1, 0, 0, scm_sys_readlink);
+SCM_PROC (s_readlink, "readlink", 1, 0, 0, scm_readlink);
SCM
-scm_sys_readlink(path)
+scm_readlink(path)
SCM path;
{
#ifdef HAVE_READLINK
scm_sizet size = 100;
char *buf;
SCM result;
- SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, (char *) SCM_ARG1, s_sys_readlink);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, (char *) SCM_ARG1, s_readlink);
SCM_DEFER_INTS;
- buf = scm_must_malloc (size, s_sys_readlink);
+ buf = scm_must_malloc (size, s_readlink);
while ((rv = readlink (SCM_CHARS (path), buf, (scm_sizet) size)) == size)
{
scm_must_free (buf);
size *= 2;
- buf = scm_must_malloc (size, s_sys_readlink);
+ buf = scm_must_malloc (size, s_readlink);
}
if (rv == -1)
- scm_syserror (s_sys_readlink);
+ scm_syserror (s_readlink);
result = scm_makfromstr (buf, rv, 0);
scm_must_free (buf);
SCM_ALLOW_INTS;
return result;
#else
- scm_sysmissing (s_sys_readlink);
+ scm_sysmissing (s_readlink);
/* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_lstat, "lstat", 1, 0, 0, scm_sys_lstat);
+SCM_PROC (s_lstat, "lstat", 1, 0, 0, scm_lstat);
SCM
-scm_sys_lstat(str)
+scm_lstat(str)
SCM str;
{
#ifdef HAVE_LSTAT
int rv;
struct stat stat_temp;
- SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat);
+ SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_lstat);
SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp));
if (rv != 0)
- scm_syserror_msg (s_sys_lstat, "%s: %S",
- scm_listify (scm_makfrom0str (strerror (errno)),
- str,
- SCM_UNDEFINED));
+ {
+ int en = errno;
+
+ scm_syserror_msg (s_lstat, "%s: %S",
+ scm_listify (scm_makfrom0str (strerror (errno)),
+ str,
+ SCM_UNDEFINED),
+ en);
+ }
return scm_stat2scm(&stat_temp);
#else
- scm_sysmissing (s_sys_lstat);
+ scm_sysmissing (s_lstat);
/* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_copy_file, "copy-file", 2, 0, 0, scm_sys_copy_file);
+SCM_PROC (s_copy_file, "copy-file", 2, 0, 0, scm_copy_file);
SCM
-scm_sys_copy_file (oldfile, newfile)
+scm_copy_file (oldfile, newfile)
SCM oldfile;
SCM newfile;
{
char buf[BUFSIZ]; /* this space could be shared. */
struct stat oldstat;
- SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_sys_copy_file);
+ 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_sys_copy_file);
+ 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_sys_copy_file);
+ scm_syserror (s_copy_file);
SCM_DEFER_INTS;
oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
if (oldfd == -1)
- scm_syserror (s_sys_copy_file);
+ scm_syserror (s_copy_file);
/* use POSIX flags instead of 07777?. */
newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
oldstat.st_mode & 07777);
if (newfd == -1)
- scm_syserror (s_sys_copy_file);
+ scm_syserror (s_copy_file);
while ((n = read (oldfd, buf, sizeof buf)) > 0)
if (write (newfd, buf, n) != n)
{
close (oldfd);
close (newfd);
- scm_syserror (s_sys_copy_file);
+ scm_syserror (s_copy_file);
}
close (oldfd);
if (close (newfd) == -1)
- scm_syserror (s_sys_copy_file);
+ scm_syserror (s_copy_file);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
{
scm_add_feature ("i/o-extensions");
- scm_tc16_fd = scm_newsmob (&fd_smob);
scm_tc16_dir = scm_newsmob (&dir_smob);
+#ifdef O_RDONLY
+scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY));
+#endif
+#ifdef O_WRONLY
+scm_sysintern ("O_WRONLY", scm_long2num (O_WRONLY));
+#endif
+#ifdef O_RDWR
+scm_sysintern ("O_RDWR", scm_long2num (O_RDWR));
+#endif
+#ifdef O_CREAT
+scm_sysintern ("O_CREAT", scm_long2num (O_CREAT));
+#endif
+#ifdef O_EXCL
+scm_sysintern ("O_EXCL", scm_long2num (O_EXCL));
+#endif
+#ifdef O_NOCTTY
+scm_sysintern ("O_NOCTTY", scm_long2num (O_NOCTTY));
+#endif
+#ifdef O_TRUNC
+scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
+#endif
+#ifdef O_APPEND
+scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
+#endif
+#ifdef O_NONBLO
+scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
+#endif
+#ifdef O_NDELAY
+scm_sysintern ("O_NDELAY", scm_long2num (O_NDELAY));
+#endif
+#ifdef O_SYNC
+scm_sysintern ("O_SYNC", scm_long2num (O_SYNC));
+#endif
+
+
+
#include "filesys.x"
}
HCoop / bpt / guile.git / blobdiff