From deda2c0fd8689349fea2a900199a76ff7ecb319e Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:26 -0800 Subject: Import Upstream version 5d6 --- ioext.c | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 90 insertions(+), 14 deletions(-) (limited to 'ioext.c') diff --git a/ioext.c b/ioext.c index 1d7f68b..62ec8b2 100644 --- a/ioext.c +++ b/ioext.c @@ -15,26 +15,26 @@ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. * * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * for additional uses of the text contained in its release of SCM. * - * The exception is that, if you link the GUILE library with other files + * The exception is that, if you link the SCM library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * linking the SCM library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy + * Free Software Foundation under the name SCM. If you copy * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does + * SCM, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * - * If you write modifications of your own for GUILE, it is your choice + * If you write modifications of your own for SCM, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ @@ -70,8 +70,11 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef __FreeBSD__ # include #endif +#ifdef __OpenBSD__ +# include +#endif /* added by Denys Duchier */ -#ifdef __svr4__ +#ifdef __SVR4 # include # include #endif @@ -81,6 +84,12 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef GO32 # include #endif +#ifdef __osf__ +# include +#endif +#ifdef __MACH__ +# include +#endif #ifndef STDC_HEADERS int chdir P((const char *path)); @@ -198,6 +207,20 @@ SCM file_set_position(port, pos) { SCM ans; ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos); +#ifndef RECKLESS + if (TRACKED & SCM_PORTFLAGS(port)) { + if (INUM0==pos) { + int i = SCM_PORTNUM(port); + scm_port_table[i].line = 1L; + scm_port_table[i].col = 1; + } + else { + if (2 <= verbose) + scm_warn("Setting file position for tracked port: ", "", port); + SCM_PORTFLAGS(port) &= (~TRACKED); + } + } +#endif CLRDY(port); /* Clear ungetted char */ SYSCALL(ans = (fseek(STREAM(port), INUM(pos), 0)) ? BOOL_F : BOOL_T;); #ifdef HAVE_PIPE @@ -217,8 +240,9 @@ SCM reopen_file(filename, modes, port) char cmodes[4]; long flags; ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file); - ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_reopen_file); + ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file); flags = mode_bits(CHARS(modes), cmodes); + ASSERT(flags, modes, ARG2, s_reopen_file); DEFER_INTS; ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file); SCM_OPENCALL(f = freopen(CHARS(filename), cmodes, STREAM(port))); @@ -227,14 +251,13 @@ SCM reopen_file(filename, modes, port) return BOOL_F; } else { - SETSTREAM(port, f); SCM_PORTFLAGS(port) = flags; - CAR(port) = scm_port_entry(tc16_fport, flags); + SCM_SETFLAGS(port, flags); if (BUF0 & flags) i_setbuf0(port); + SCM_PORTDATA(port) = filename; } ALLOW_INTS; - SCM_PORTDATA(port) = filename; return port; } @@ -250,19 +273,25 @@ SCM l_dup(oldpt, modes) FILE *f; SCM newpt; ASSERT(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup); - ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_dup); + ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup); flags = mode_bits(CHARS(modes), cmodes); + ASSERT(flags, modes, ARG2, s_dup); NEWCELL(newpt); DEFER_INTS; SCM_OPENCALL(tfd = dup(fileno(STREAM(oldpt)))); if (-1==tfd) {ALLOW_INTS;return BOOL_F;}; SYSCALL(f = fdopen(tfd, cmodes);); if (!f) { + int lerrno = errno; close(tfd); + errno = lerrno; +# ifdef EINVAL + if (lerrno==EINVAL) wta(modes, (char *)ARG2, s_dup); +# endif wta(MAKINUM(tfd), (char *)NALLOC, s_port_type); } - SETSTREAM(newpt, f); - CAR(newpt) = scm_port_entry(tc16_fport, flags); + newpt = scm_port_entry(f, tc16_fport, flags); + SCM_PORTDATA(newpt) = SCM_PORTDATA(oldpt); if (BUF0 & flags) i_setbuf0(newpt); ALLOW_INTS; @@ -690,6 +719,49 @@ static iproc subr2s[] = { #endif {0, 0}}; +#include /* for O_RDONLY, O_RDWR, O_EXCL */ +#ifdef O_EXCL +SCM scm_try_create_file(fname, modes, perms) + SCM fname, modes, perms; +{ + SCM port; + FILE *f; + char cmodes[4]; + long flags; + int fd, fdflags = O_CREAT | O_EXCL; +# ifdef S_IROTH + mode_t cperms = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; +# else + int cperms = 0666; +# endif + ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file); + ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file); + if (NNULLP(perms)) { + perms = CAR(perms); + ASSERT(INUMP(perms), perms, ARG3, s_try_create_file); +# ifdef S_IROTH + cperms = (mode_t)INUM(perms); +# else + cperms = INUM(perms); +# endif + } + flags = mode_bits(CHARS(modes), cmodes); + ASSERT(flags, modes, ARG2, s_try_create_file); + fdflags |= (RDNG & flags) ? O_RDWR : O_WRONLY; + DEFER_INTS; + SCM_OPENCALL(fd = open(CHARS(fname), fdflags, cperms)); + if (fd >= 0 && (f = fdopen(fd, cmodes))) { + port = scm_port_entry(f, tc16_fport, flags); + if (BUF0 & flags) i_setbuf0(port); + SCM_PORTDATA(port) = fname; + } + else + port = BOOL_F; + ALLOW_INTS; + return port; +} +#endif + static iproc subr2os[] = { {s_file_set_pos, file_set_position}, {s_read_line1, read_line1}, @@ -702,6 +774,9 @@ void init_ioext() init_iprocs(subr1s, tc7_subr_1); init_iprocs(subr2os, tc7_subr_2o); init_iprocs(subr2s, tc7_subr_2); +#ifdef O_EXCL + make_subr(s_try_create_file, tc7_lsubr_2, scm_try_create_file); +#endif make_subr(s_reopen_file, tc7_subr_3, reopen_file); #ifndef THINK_C # ifndef MCH_AMIGA @@ -733,6 +808,7 @@ void init_ioext() add_feature("i/o-extensions"); add_feature("line-i/o"); scm_ldstr("\n\ +(define (file-exists? path) (access path \"r\"))\n\ (define (directory-for-each proc dirname . args)\n\ (define dir (opendir (if (symbol? dirname)\n\ (symbol->string dirname)\n\ -- cgit v1.2.3