diff options
author | LaMont Jones <lamont@debian.org> | 2003-05-07 08:36:40 -0600 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | e21d47d7813159bb71e0671df9b52ec0470c358d (patch) | |
tree | 3c7770ea846123c291f599044e9f234ac17616bb /ioext.c | |
parent | 8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff) | |
parent | deda2c0fd8689349fea2a900199a76ff7ecb319e (diff) | |
download | scm-debian/5d6-3.2.tar.gz scm-debian/5d6-3.2.zip |
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low
* Fix hppa compile. Closes: #144062
scm (5d6-3.1) unstable; urgency=low
* NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171
scm (5d6-3) unstable; urgency=low
* Add build depend on xlibs-dev (Closes: #148020)
scm (5d6-2) unstable; urgency=low
* Remove libregexx-dev from build-depends.
* Change build to use ./scmlit rather than scmlit (should fix some build
problems) (looks like alpha is mostly building)
* New release (Closes: #140175)
* Built with turtlegraphics last time (Closes: #58515)
scm (5d6-1) unstable; urgency=low
* New upstream.
* Add xlib and turtlegr to requested list of features. (closes
some bug)
* Make clean actually clean most everything up.
* Remove hacks renaming build to something else and just set build as a
.PHONY target in debian/rules.
* Add the turtlegr code.
scm (5d5-1) unstable; urgency=low
* New upstream
* Has fixes for 64 bit archs. May fix alpha compile problem. Does fix
(Closes: #140175)
* Take out -O2 arg.
scm (5d4-3) unstable; urgency=low
* Don't link with regexx, but just use libc6's regular expression
functions.
* Define (terms) to output /usr/share/common-licenses/GPL (Closes:
#119321)
scm (5d4-2) unstable; urgency=low
* Add texinfo to build depends (Closes: #107011)
scm (5d4-1) unstable; urgency=low
* New upstream release.
* Move install-info --remove to prerm.
scm (5d3-5) unstable; urgency=low
* Move scm info files to section "The Algorithmic Language Scheme" to
match up with guile.
scm (5d3-4) unstable; urgency=low
* Fix build depends (Closes: #76691)
scm (5d3-3) unstable; urgency=low
* Fix path in scm dhelp file.
scm (5d3-2) unstable; urgency=low
* Actually put the header files in the package. Oops.
scm (5d3-1) unstable; urgency=low
* New upstream. (Closes: #74761)
* Make (terms) use new license location.
* Make use libregexx rather than librx.
* Fix build depends for above.
* Using new regex lib seems to fix crash (Closes: #66787)
* Consider adding scm-dev package with headers, but instead just add the
headers to the scm package. (Closes: #70787)
* Add doc-base support.
Diffstat (limited to 'ioext.c')
-rw-r--r-- | ioext.c | 104 |
1 files changed, 90 insertions, 14 deletions
@@ -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 <unistd.h> #endif +#ifdef __OpenBSD__ +# include <unistd.h> +#endif /* added by Denys Duchier */ -#ifdef __svr4__ +#ifdef __SVR4 # include <sys/types.h> # include <unistd.h> #endif @@ -81,6 +84,12 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef GO32 # include <unistd.h> #endif +#ifdef __osf__ +# include <unistd.h> +#endif +#ifdef __MACH__ +# include <unistd.h> +#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 <fcntl.h> /* 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\ |