From 3d8d56dfacd9a9072903e4b9c09ab1a81cd873cb Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 18 Jan 1997 17:51:33 +0000 Subject: [PATCH] * 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 (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 for "read" prototype. --- libguile/ChangeLog | 44 ++++ libguile/error.c | 7 +- libguile/error.h | 6 +- libguile/filesys.c | 592 +++++++++++++++------------------------------ libguile/filesys.h | 64 ++--- libguile/fports.c | 9 +- libguile/socket.c | 3 +- libguile/strop.c | 8 +- libguile/unif.c | 162 ++++++++++--- libguile/unif.h | 6 +- 10 files changed, 403 insertions(+), 498 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c2b25616f..09b35982e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,47 @@ +Sat Jan 18 00:03:31 1997 Gary Houston + + * 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 + (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 for "read" prototype. + +Tue Jan 14 02:42:02 1997 Gary Houston + + * socket.c: don't include filesys.h. + Mon Jan 13 03:47:04 1997 Gary Houston * Makefile.am: add AWK=@AWK@ (?) diff --git a/libguile/error.c b/libguile/error.c index 93ec9debf..3facf167d 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -164,16 +164,17 @@ scm_syserror (subr) } void -scm_syserror_msg (subr, message, args) +scm_syserror_msg (subr, message, args, eno) char *subr; char *message; SCM args; + int eno; { scm_error (scm_system_error_key, subr, message, args, - scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); + scm_listify (SCM_MAKINUM (eno), SCM_UNDEFINED)); } void diff --git a/libguile/error.h b/libguile/error.h index 0ce16289a..f71019bb1 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -2,7 +2,7 @@ #ifndef ERRORH #define ERRORH -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -67,8 +67,8 @@ extern void scm_error SCM_P ((SCM key, char *subr, char *message, extern void (*scm_error_callback) SCM_P ((SCM key, char *subr, char *message, SCM args, SCM rest)); extern void scm_syserror SCM_P ((char *subr)) SCM_NORETURN; -extern void scm_syserror_msg SCM_P ((char *subr, char *message, SCM args)) - SCM_NORETURN; +extern void scm_syserror_msg SCM_P ((char *subr, char *message, SCM args, + int eno)) SCM_NORETURN; extern void scm_sysmissing SCM_P ((char *subr)) SCM_NORETURN; extern void scm_num_overflow SCM_P ((char *subr)) SCM_NORETURN; extern void scm_out_of_range SCM_P ((char *subr, SCM bad_value)) SCM_NORETURN; 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 #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, "#", 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" } diff --git a/libguile/filesys.h b/libguile/filesys.h index ff7a28664..dd73537bd 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -2,7 +2,7 @@ #ifndef FILESYSH #define FILESYSH -/* Copyright (C) 1995 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -49,57 +49,33 @@ -extern long scm_tc16_fd; - -#define SCM_FD_P(x) (SCM_TYP16(x)==(scm_tc16_fd)) -#define SCM_FD_FLAGS(x) (SCM_CAR(x) >> 16) -#define SCM_FD(x) ((int)SCM_CDR (x)) - -enum scm_fd_flags -{ - scm_fd_is_open = 1, - scm_close_fd_on_gc = 2 -}; - - - - extern long scm_tc16_dir; #define SCM_DIRP(x) (SCM_TYP16(x)==(scm_tc16_dir)) #define SCM_OPDIRP(x) (SCM_CAR(x)==(scm_tc16_dir | SCM_OPN)) - - -extern SCM scm_sys_chown SCM_P ((SCM path, SCM owner, SCM group)); -extern SCM scm_sys_chmod SCM_P ((SCM port_or_path, SCM mode)); +extern SCM scm_chown SCM_P ((SCM path, SCM owner, SCM group)); +extern SCM scm_chmod SCM_P ((SCM port_or_path, SCM mode)); extern SCM scm_umask SCM_P ((SCM mode)); -extern SCM scm_intern_fd SCM_P ((int fd, int flags)); -extern SCM scm_sys_open SCM_P ((SCM path, SCM flags, SCM mode)); -extern SCM scm_sys_create SCM_P ((SCM path, SCM mode)); -extern SCM scm_sys_close SCM_P ((SCM sfd)); -extern SCM scm_sys_write_fd SCM_P ((SCM sfd, SCM buf)); -extern SCM scm_sys_read_fd SCM_P ((SCM sfd, SCM buf, SCM offset, SCM length)); -extern SCM scm_sys_lseek SCM_P ((SCM sfd, SCM offset, SCM whence)); -extern SCM scm_sys_dup SCM_P ((SCM oldfd, SCM newfd)); -extern SCM scm_sys_stat SCM_P ((SCM fd_or_path)); -extern SCM scm_sys_link SCM_P ((SCM oldpath, SCM newpath)); -extern SCM scm_sys_rename SCM_P ((SCM oldname, SCM newname)); -extern SCM scm_sys_delete_file SCM_P ((SCM str)); -extern SCM scm_sys_mkdir SCM_P ((SCM path, SCM mode)); -extern SCM scm_sys_rmdir SCM_P ((SCM path)); -extern SCM scm_sys_opendir SCM_P ((SCM dirname)); -extern SCM scm_sys_readdir SCM_P ((SCM port)); +extern SCM scm_open SCM_P ((SCM path, SCM flags, SCM mode)); +extern SCM scm_stat SCM_P ((SCM fd_or_path)); +extern SCM scm_link SCM_P ((SCM oldpath, SCM newpath)); +extern SCM scm_rename SCM_P ((SCM oldname, SCM newname)); +extern SCM scm_delete_file SCM_P ((SCM str)); +extern SCM scm_mkdir SCM_P ((SCM path, SCM mode)); +extern SCM scm_rmdir SCM_P ((SCM path)); +extern SCM scm_opendir SCM_P ((SCM dirname)); +extern SCM scm_readdir SCM_P ((SCM port)); extern SCM scm_rewinddir SCM_P ((SCM port)); -extern SCM scm_sys_closedir SCM_P ((SCM port)); -extern SCM scm_sys_chdir SCM_P ((SCM str)); -extern SCM scm_sys_getcwd SCM_P ((void)); -extern SCM scm_sys_select SCM_P ((SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)); +extern SCM scm_closedir SCM_P ((SCM port)); +extern SCM scm_chdir SCM_P ((SCM str)); +extern SCM scm_getcwd SCM_P ((void)); +extern SCM scm_select SCM_P ((SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)); extern int scm_input_waiting_p SCM_P ((FILE *file, char *caller)); -extern SCM scm_sys_symlink SCM_P ((SCM oldpath, SCM newpath)); -extern SCM scm_sys_readlink SCM_P ((SCM path)); -extern SCM scm_sys_lstat SCM_P ((SCM str)); -extern SCM scm_sys_copy_file SCM_P ((SCM oldfile, SCM newfile)); +extern SCM scm_symlink SCM_P ((SCM oldpath, SCM newpath)); +extern SCM scm_readlink SCM_P ((SCM path)); +extern SCM scm_lstat SCM_P ((SCM str)); +extern SCM scm_copy_file SCM_P ((SCM oldfile, SCM newfile)); extern void scm_init_filesys SCM_P ((void)); #endif /* FILESYSH */ diff --git a/libguile/fports.c b/libguile/fports.c index 928aeeff5..57e9ab835 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -95,12 +95,10 @@ scm_setbuf0 (port) { #ifndef NOSETBUF #ifndef MSDOS -#ifdef FIONREAD #ifndef ultrix SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0);); #endif #endif -#endif #endif return SCM_UNSPECIFIED; } @@ -159,10 +157,13 @@ scm_open_file (filename, modes) SCM_SYSCALL (f = fopen (file, mode)); if (!f) { + int en = errno; + scm_syserror_msg (s_open_file, "%s: %S", scm_listify (scm_makfrom0str (strerror (errno)), filename, - SCM_UNDEFINED)); + SCM_UNDEFINED), + en); } else { diff --git a/libguile/socket.c b/libguile/socket.c index 06fe86ac4..b8795a2f7 100644 --- a/libguile/socket.c +++ b/libguile/socket.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 @@ -43,7 +43,6 @@ #include #include "_scm.h" -#include "filesys.h" #include "unif.h" #include "feature.h" #include "fports.h" diff --git a/libguile/strop.c b/libguile/strop.c index 2f73f9724..c0e95561c 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -1,6 +1,6 @@ /* classes: src_files */ -/* Copyright (C) 1994 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1996, 1997 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 @@ -293,8 +293,10 @@ SCM scm_string_copy (str) SCM str; { - SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_string_copy); - return scm_makfromstr (SCM_CHARS (str), (scm_sizet)SCM_LENGTH (str), 0); + /* doesn't handle multibyte strings. */ + SCM_ASSERT (SCM_NIMP (str) && (SCM_STRINGP (str) || SCM_SUBSTRP (str)), + str, SCM_ARG1, s_string_copy); + return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str), 0); } diff --git a/libguile/unif.c b/libguile/unif.c index 87be8a22d..8e181f1a4 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -53,6 +53,10 @@ #include "unif.h" #include "ramap.h" +#ifdef HAVE_UNISTD_H +#include +#endif + /* The set of uniform scm_vector types is: * Vector of: Called: @@ -1430,25 +1434,29 @@ scm_ra2contig (ra, copy) -SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 1, 0, scm_uniform_array_read_x); +SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, scm_uniform_array_read_x); SCM -scm_uniform_array_read_x (ra, port) +scm_uniform_array_read_x (ra, port_or_fd, offset, length) SCM ra; - SCM port; + SCM port_or_fd; + SCM offset; + SCM length; { SCM cra = SCM_UNDEFINED, v = ra; - long sz, len, ans; + long sz, vlen, ans; long start = 0; + long len_to_read; - if (SCM_UNBNDP (port)) - port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINFPORTP (port), port, SCM_ARG2, - s_uniform_array_read_x); SCM_ASRTGO (SCM_NIMP (v), badarg1); + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_cur_inp; + else + SCM_ASSERT (SCM_INUMP (port_or_fd) + || (SCM_NIMP (port_or_fd) && SCM_OPINFPORTP (port_or_fd)), + port_or_fd, SCM_ARG2, s_uniform_array_read_x); + vlen = SCM_LENGTH (v); - len = SCM_LENGTH (v); loop: switch SCM_TYP7 (v) { @@ -1457,8 +1465,8 @@ loop: case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); cra = scm_ra2contig (ra, 0); - start = SCM_ARRAY_BASE (cra); - len = SCM_ARRAY_DIMS (cra)->inc * + start += SCM_ARRAY_BASE (cra); + vlen = SCM_ARRAY_DIMS (cra)->inc * (SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1); v = SCM_ARRAY_V (cra); goto loop; @@ -1467,7 +1475,7 @@ loop: sz = sizeof (char); break; case scm_tc7_bvect: - len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; start /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: @@ -1495,19 +1503,52 @@ loop: break; #endif } + + len_to_read = vlen; + if (!SCM_UNBNDP (offset)) + { + long loff = + scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_read_x); - /* An ungetc before an fread will not work on some systems if setbuf(0). - do #define NOSETBUF in scmfig.h to fix this. */ - if (SCM_CRDYP (port)) - { /* UGGH!!! */ - ungetc (SCM_CGETUN (port), (FILE *)SCM_STREAM (port)); - SCM_CLRDY (port); /* Clear ungetted char */ + if (loff < 0 || loff >= vlen) + scm_out_of_range (s_uniform_array_read_x, offset); + start += loff; + len_to_read -= loff; + } + if (!SCM_UNBNDP (length)) + { + long llen = + scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + + if (llen < 0 || llen > len_to_read) + scm_out_of_range (s_uniform_array_read_x, length); + len_to_read = llen; } - SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, - (scm_sizet) sz, (scm_sizet) len, - (FILE *)SCM_STREAM (port))); - + if (SCM_NIMP (port_or_fd)) + { + /* if we have stored a character from the port in our own buffer, + push it back onto the stream. */ + /* An ungetc before an fread will not work on some systems if + setbuf(0). do #define NOSETBUF in scmfig.h to fix this. */ + if (SCM_CRDYP (port_or_fd)) + { + ungetc (SCM_CGETUN (port_or_fd), (FILE *)SCM_STREAM (port_or_fd)); + SCM_CLRDY (port_or_fd); /* Clear ungetted char */ + } + SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, + (scm_sizet) sz, (scm_sizet) len_to_read, + (FILE *)SCM_STREAM (port_or_fd))); + + } + else /* file descriptor. */ + { + SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd), + SCM_CHARS (v) + start * sz, + (scm_sizet) (sz * len_to_read))); + if (ans == -1) + scm_syserror (s_uniform_array_read_x); + } if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; @@ -1517,24 +1558,30 @@ loop: return SCM_MAKINUM (ans); } -SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 1, 0, scm_uniform_array_write); +SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 3, 0, scm_uniform_array_write); SCM -scm_uniform_array_write (v, port) +scm_uniform_array_write (v, port_or_fd, offset, length) SCM v; - SCM port; + SCM port_or_fd; + SCM offset; + SCM length; { - long sz, len, ans; + long sz, vlen, ans; long start = 0; - if (SCM_UNBNDP (port)) - port = scm_cur_outp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTFPORTP (port), port, SCM_ARG2, s_uniform_array_write); + long len_to_write; + SCM_ASRTGO (SCM_NIMP (v), badarg1); - len = SCM_LENGTH (v); + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_cur_outp; + else + SCM_ASSERT (SCM_INUMP (port_or_fd) + || (SCM_NIMP (port_or_fd) && SCM_OPOUTFPORTP (port_or_fd)), + port_or_fd, SCM_ARG2, s_uniform_array_write); + vlen = SCM_LENGTH (v); + loop: - switch SCM_TYP7 - (v) + switch SCM_TYP7 (v) { default: badarg1:scm_wta (v, (char *) SCM_ARG1, s_uniform_array_write); @@ -1542,15 +1589,16 @@ loop: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); v = scm_ra2contig (v, 1); start = SCM_ARRAY_BASE (v); - len = SCM_ARRAY_DIMS (v)->inc * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1); + vlen = SCM_ARRAY_DIMS (v)->inc + * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1); v = SCM_ARRAY_V (v); goto loop; - case scm_tc7_byvect: case scm_tc7_string: + case scm_tc7_byvect: sz = sizeof (char); break; case scm_tc7_bvect: - len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; start /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: @@ -1578,9 +1626,45 @@ loop: break; #endif } - SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, (scm_sizet) sz, (scm_sizet) len, (FILE *)SCM_STREAM (port))); + + len_to_write = vlen; + if (!SCM_UNBNDP (offset)) + { + long loff = + scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_write); + + if (loff < 0 || loff >= vlen) + scm_out_of_range (s_uniform_array_write, offset); + start += loff; + len_to_write -= loff; + } + if (!SCM_UNBNDP (length)) + { + long llen = + scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + + if (llen < 0 || llen > len_to_write) + scm_out_of_range (s_uniform_array_read_x, length); + len_to_write = llen; + } + + if (SCM_NIMP (port_or_fd)) + { + SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, + (scm_sizet) sz, (scm_sizet) len_to_write, + (FILE *)SCM_STREAM (port_or_fd))); + } + else /* file descriptor. */ + { + SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd), + SCM_CHARS (v) + start * sz, + (scm_sizet) (sz * len_to_write))); + if (ans == -1) + scm_syserror (s_uniform_array_write); + } if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; + return SCM_MAKINUM (ans); } diff --git a/libguile/unif.h b/libguile/unif.h index 45aef3fe2..82a6088fe 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -2,7 +2,7 @@ #ifndef UNIFH #define UNIFH -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -95,8 +95,8 @@ extern SCM scm_cvref SCM_P ((SCM v, scm_sizet pos, SCM last)); extern SCM scm_array_set_x SCM_P ((SCM v, SCM obj, SCM args)); extern SCM scm_array_contents SCM_P ((SCM ra, SCM strict)); extern SCM scm_ra2contig SCM_P ((SCM ra, int copy)); -extern SCM scm_uniform_array_read_x SCM_P ((SCM ra, SCM port)); -extern SCM scm_uniform_array_write SCM_P ((SCM v, SCM port)); +extern SCM scm_uniform_array_read_x SCM_P ((SCM ra, SCM port_or_fd, SCM offset, SCM length)); +extern SCM scm_uniform_array_write SCM_P ((SCM v, SCM port_or_fd, SCM offset, SCM length)); extern SCM scm_bit_count SCM_P ((SCM item, SCM seq)); extern SCM scm_bit_position SCM_P ((SCM item, SCM v, SCM k)); extern SCM scm_bit_set_star_x SCM_P ((SCM v, SCM kv, SCM obj)); -- 2.20.1