diff options
author | Gary Houston <ghouston@arglist.com> | 1997-01-18 17:51:33 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1997-01-18 17:51:33 +0000 |
commit | 3d8d56dfacd9a9072903e4b9c09ab1a81cd873cb (patch) | |
tree | 9436d8f9ad3a89adc4e37f051efb46e21c8a54f6 /libguile/filesys.c | |
parent | 3f81f8f238fc2c467a867d5e72f83baa22ac7914 (diff) | |
download | guile-3d8d56dfacd9a9072903e4b9c09ab1a81cd873cb.tar.gz |
* init.scm (index, rindex): replace versions in utilities.scm with
primitives.
load errno.scm.
* netconst.scm: undefine maybe-define and maybe-define-so after use.
* errno.scm: new file.
* fports.c (scm_open_file): pass errno to scm_syserror_msg.
* filesys.h: update prototypes. Remove macros: SCM_FD_P, SCM_FD_FLAGS,
SCM_FD.
* filesys.c (scm_sys_stat, scm_sys_lstat): pass errno to
scm_syserror_msg.
* (scm_sys_read_fd, scm_sys_write_fd, scm_sys_close, scm_sys_lseek,
scm_sys_dup): deleted: FD capability will be added to other
procedures.
* Remove support for the FD object type: scm_tc16_fd, scm_fd_print,
scm_fd_free, fd_smob, scm_intern_fd.
* (scm_open): renamed from scm_sys_open. Return a port instead of
an FD object. Make the mode argument optional.
* (scm_sys_create): deleted, it's just a special case of open.
(scm_init_filesys): move interning of constants O_CREAT etc.,
here (were previously using SCM_CONST_LONG macro).
Add missing constants: O_RDONLY, O_WRONLY, O_RDWR, O_CREAT.
don't newsmob fd.
(numerous _sys_ procedures): remove gratuitous _sys_ from names.
include "fports.h" and <stdio.h>
(scm_stat, scm_select): don't support FD objects.
* error.h: adjust scm_syserror_msg prototype.
* error.c (scm_syserror_msg): take an extra argument for errno.
Using the global value didn't always work, since it could be
reset by procedure calls in the message or args arguments.
* fports.c (scm_setbuf0): call setbuf even if FIONREAD is not defined.
I don't understand why the check was there (and what about the
ultrix check?)
* strop.c (scm_string_copy): allow shared substrings to be copied.
* unif.h: corresponding change to prototypes.
* unif.c (scm_uniform_array_read_x, scm_uniform_array_write_x):
recognize two new optional arguments: offset and length. Allow
the port argument to be an integer (file descriptor, for scsh).
Include <unistd.h> for "read" prototype.
Diffstat (limited to 'libguile/filesys.c')
-rw-r--r-- | libguile/filesys.c | 592 |
1 files changed, 195 insertions, 397 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 1f65c8875..88a1e3aea 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,4 +1,4 @@ -/* 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 @@ -39,10 +39,12 @@ * If you do not wish that, delete this exception notice. */ +#include <stdio.h> #include "_scm.h" #include "genio.h" #include "smob.h" #include "feature.h" +#include "fports.h" #include "filesys.h" @@ -116,89 +118,56 @@ -#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 - - /* {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; } @@ -223,272 +192,68 @@ scm_umask (mode) } -/* {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 -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; -} - - -SCM_PROC (s_sys_open, "open", 3, 0, 0, scm_sys_open); +SCM_PROC (s_open, "open", 2, 1, 0, scm_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; } - /* {Files} */ @@ -593,10 +358,10 @@ scm_stat2scm (stat_temp) 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; @@ -607,15 +372,10 @@ scm_sys_stat (fd_or_path) 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)) @@ -625,10 +385,15 @@ scm_sys_stat (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); } @@ -637,43 +402,43 @@ scm_sys_stat (fd_or_path) /* {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; @@ -687,38 +452,38 @@ scm_sys_rename (oldname, newname) } 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); @@ -727,36 +492,36 @@ scm_sys_mkdir (path, mode) } 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 @@ -768,20 +533,20 @@ scm_sys_rmdir (path) 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; @@ -789,20 +554,20 @@ scm_sys_opendir (dirname) } -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); } @@ -822,15 +587,15 @@ scm_rewinddir (port) -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)) { @@ -839,7 +604,7 @@ scm_sys_closedir (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; @@ -879,27 +644,27 @@ static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0}; */ -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; @@ -909,21 +674,21 @@ scm_sys_getcwd () 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 @@ -947,8 +712,6 @@ fill_select_type (set, list) 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); } } @@ -977,11 +740,6 @@ retrieve_select_type (set, 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; @@ -991,10 +749,10 @@ retrieve_select_type (set, list) /* {Checking for events} */ -SCM_PROC (s_sys_select, "select", 3, 2, 0, scm_sys_select); +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; @@ -1009,9 +767,9 @@ scm_sys_select (reads, writes, excepts, secs, msecs) 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); @@ -1025,11 +783,11 @@ scm_sys_select (reads, writes, excepts, secs, msecs) 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); @@ -1040,14 +798,14 @@ scm_sys_select (reads, writes, excepts, secs, 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 @@ -1168,34 +926,34 @@ scm_input_waiting_p (f, caller) /* {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 @@ -1203,59 +961,64 @@ scm_sys_readlink(path) 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; { @@ -1264,35 +1027,35 @@ scm_sys_copy_file (oldfile, 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; } @@ -1304,8 +1067,43 @@ scm_init_filesys () { 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" } |