X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/cc95e00ac63820cbc03ca858ff6b8e1015c9d168..2f4aae6bce7986ad724b374d1a72a6d4c48b462c:/libguile/fports.c diff --git a/libguile/fports.c b/libguile/fports.c index 35789ff6e..683c25bde 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,23 +1,27 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc. - * +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, + * 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + * * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ -#if HAVE_CONFIG_H +#define _LARGEFILE64_SOURCE /* ask for stat64 etc */ + +#ifdef HAVE_CONFIG_H # include #endif @@ -29,6 +33,7 @@ #include "libguile/gc.h" #include "libguile/posix.h" #include "libguile/dynwind.h" +#include "libguile/hashtab.h" #include "libguile/fports.h" @@ -37,8 +42,6 @@ #endif #ifdef HAVE_UNISTD_H #include -#else -size_t fwrite (); #endif #ifdef HAVE_IO_H #include @@ -46,8 +49,13 @@ size_t fwrite (); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE #include #endif - +#ifdef HAVE_POLL_H +#include +#endif #include +#include + +#include #include "libguile/iselect.h" @@ -55,9 +63,35 @@ size_t fwrite (); #ifdef __MINGW32__ # include # include -# define ftruncate(fd, size) chsize (fd, size) #endif /* __MINGW32__ */ +#include + +/* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize + already, but have this code here in case that wasn't so in past versions, + or perhaps to help other minimal DOS environments. + + gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which + might be possibilities if we've got other systems without ftruncate. */ + +#if defined HAVE_CHSIZE && ! defined HAVE_FTRUNCATE +# define ftruncate(fd, size) chsize (fd, size) +# undef HAVE_FTRUNCATE +# define HAVE_FTRUNCATE 1 +#endif + +#if SIZEOF_OFF_T == SIZEOF_INT +#define OFF_T_MAX INT_MAX +#define OFF_T_MIN INT_MIN +#elif SIZEOF_OFF_T == SIZEOF_LONG +#define OFF_T_MAX LONG_MAX +#define OFF_T_MIN LONG_MIN +#elif SIZEOF_OFF_T == SIZEOF_LONG_LONG +#define OFF_T_MAX LONG_LONG_MAX +#define OFF_T_MIN LONG_LONG_MIN +#else +#error Oops, unknown OFF_T size +#endif scm_t_bits scm_tc16_fport; @@ -93,7 +127,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size) if (SCM_INPUT_PORT_P (port) && read_size > 0) { - pt->read_buf = scm_gc_malloc (read_size, "port buffer"); + pt->read_buf = scm_gc_malloc_pointerless (read_size, "port buffer"); pt->read_pos = pt->read_end = pt->read_buf; pt->read_buf_size = read_size; } @@ -105,7 +139,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size) if (SCM_OUTPUT_PORT_P (port) && write_size > 0) { - pt->write_buf = scm_gc_malloc (write_size, "port buffer"); + pt->write_buf = scm_gc_malloc_pointerless (write_size, "port buffer"); pt->write_pos = pt->write_buf; pt->write_buf_size = write_size; } @@ -139,6 +173,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, { int cmode; long csize; + SCM drained; scm_t_port *pt; port = SCM_COERCE_OUTPORT (port); @@ -155,7 +190,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, } else { - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) ^ SCM_BUFLINE); + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE); } if (SCM_UNBNDP (size)) @@ -174,7 +209,14 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt = SCM_PTAB_ENTRY (port); - /* silently discards buffered and put-back chars. */ + if (SCM_INPUT_PORT_P (port)) + drained = scm_drain_input (port); + else + drained = scm_nullstr; + + if (SCM_OUTPUT_PORT_P (port)) + scm_flush_unlocked (port); + if (pt->read_buf == pt->putback_buf) { pt->read_buf = pt->saved_read_buf; @@ -188,6 +230,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); scm_fport_buffer_add (port, csize, csize); + + if (scm_is_true (drained) && scm_c_string_length (drained)) + scm_unread_string (drained, port); + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -195,33 +241,35 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, /* Move ports with the specified file descriptor to new descriptors, * resetting the revealed count to 0. */ - -void -scm_evict_ports (int fd) +static void +scm_i_evict_port (void *closure, SCM port) { - long i; + int fd = * (int*) closure; - scm_mutex_lock (&scm_i_port_table_mutex); - - for (i = 0; i < scm_i_port_table_size; i++) + if (SCM_FPORTP (port)) { - SCM port = scm_i_port_table[i]->port; + scm_t_port *p; + scm_t_fport *fp; - if (SCM_FPORTP (port)) - { - scm_t_fport *fp = SCM_FSTREAM (port); + /* XXX: In some cases, we can encounter a port with no associated ptab + entry. */ + p = SCM_PTAB_ENTRY (port); + fp = (p != NULL) ? (scm_t_fport *) p->stream : NULL; - if (fp->fdes == fd) - { - fp->fdes = dup (fd); - if (fp->fdes == -1) - scm_syserror ("scm_evict_ports"); - scm_set_port_revealed_x (port, scm_from_int (0)); - } + if ((fp != NULL) && (fp->fdes == fd)) + { + fp->fdes = dup (fd); + if (fp->fdes == -1) + scm_syserror ("scm_evict_ports"); + scm_set_port_revealed_x (port, scm_from_int (0)); } } +} - scm_mutex_unlock (&scm_i_port_table_mutex); +void +scm_evict_ports (int fd) +{ + scm_c_port_for_each (scm_i_evict_port, (void *) &fd); } @@ -235,6 +283,46 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0, #undef FUNC_NAME +static SCM sys_file_port_name_canonicalization; +SCM_SYMBOL (sym_relative, "relative"); +SCM_SYMBOL (sym_absolute, "absolute"); + +static SCM +fport_canonicalize_filename (SCM filename) +{ + SCM mode = scm_fluid_ref (sys_file_port_name_canonicalization); + + if (!scm_is_string (filename)) + { + return filename; + } + else if (scm_is_eq (mode, sym_relative)) + { + SCM path, rel; + + path = scm_variable_ref (scm_c_module_lookup (scm_the_root_module (), + "%load-path")); + rel = scm_i_relativize_path (filename, path); + + return scm_is_true (rel) ? rel : filename; + } + else if (scm_is_eq (mode, sym_absolute)) + { + char *str, *canon; + + str = scm_to_locale_string (filename); + canon = canonicalize_file_name (str); + free (str); + + return canon ? scm_take_locale_string (canon) : filename; + } + else + { + return filename; + } +} + + /* scm_open_file * Return a new port open on a given file. * @@ -244,7 +332,7 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0, * Return the new port. */ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, - (SCM filename, SCM mode), + (SCM filename, SCM mode), "Open the file whose name is @var{filename}, and return a port\n" "representing that file. The attributes of the port are\n" "determined by the @var{mode} string. The way in which this is\n" @@ -264,6 +352,11 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, "@end table\n" "The following additional characters can be appended:\n" "@table @samp\n" + "@item b\n" + "Open the underlying file in binary mode, if supported by the system.\n" + "Also, open the file using the binary-compatible character encoding\n" + "\"ISO-8859-1\", ignoring the port's encoding and the coding declaration\n" + "at the top of the input file, if any.\n" "@item +\n" "Open the port for both input and output. E.g., @code{r+}: open\n" "an existing file for both input and output.\n" @@ -278,6 +371,11 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, "Add line-buffering to the port. The port output buffer will be\n" "automatically flushed whenever a newline character is written.\n" "@end table\n" + "When the file is opened, this procedure will scan for a coding\n" + "declaration@pxref{Character Encoding of Source Files}. If present\n" + "will use that encoding for interpreting the file. Otherwise, the\n" + "port's encoding will be used.\n" + "\n" "In theory we could create read/write ports which were buffered\n" "in one direction only. However this isn't included in the\n" "current interfaces. If a file cannot be opened with the access\n" @@ -285,19 +383,17 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, #define FUNC_NAME s_scm_open_file { SCM port; - int fdes; - int flags = 0; - char *file; - char *md; - char *ptr; + int fdes, flags = 0, use_encoding = 1; + unsigned int retries; + char *file, *md, *ptr; - scm_frame_begin (0); + scm_dynwind_begin (0); file = scm_to_locale_string (filename); - scm_frame_free (file); + scm_dynwind_free (file); md = scm_to_locale_string (mode); - scm_frame_free (md); + scm_dynwind_free (md); switch (*md) { @@ -322,6 +418,7 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR; break; case 'b': + use_encoding = 0; #if defined (O_BINARY) flags |= O_BINARY; #endif @@ -334,18 +431,49 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, } ptr++; } - SCM_SYSCALL (fdes = open (file, flags, 0666)); - if (fdes == -1) + + for (retries = 0, fdes = -1; + fdes < 0 && retries < 2; + retries++) { - int en = errno; + SCM_SYSCALL (fdes = open_or_open64 (file, flags, 0666)); + if (fdes == -1) + { + int en = errno; - SCM_SYSERROR_MSG ("~A: ~S", - scm_cons (scm_strerror (scm_from_int (en)), - scm_cons (filename, SCM_EOL)), en); + if (en == EMFILE && retries == 0) + /* Run the GC in case it collects open file ports that are no + longer referenced. */ + scm_i_gc (FUNC_NAME); + else + SCM_SYSERROR_MSG ("~A: ~S", + scm_cons (scm_strerror (scm_from_int (en)), + scm_cons (filename, SCM_EOL)), en); + } } - port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), filename); - scm_frame_end (); + /* Create a port from this file descriptor. The port's encoding is initially + %default-port-encoding. */ + port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), + fport_canonicalize_filename (filename)); + + if (use_encoding) + { + /* If this file has a coding declaration, use that as the port + encoding. */ + if (SCM_INPUT_PORT_P (port)) + { + char *enc = scm_i_scan_for_encoding (port); + if (enc != NULL) + scm_i_set_port_encoding_x (port, enc); + } + } + else + /* If this is a binary file, use the binary-friendly ISO-8859-1 + encoding. */ + scm_i_set_port_encoding_x (port, NULL); + + scm_dynwind_end (); return port; } @@ -406,7 +534,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) #define FUNC_NAME "scm_fdes_to_port" { SCM port; - scm_t_port *pt; + scm_t_fport *fp; int flags; /* test that fdes is valid. */ @@ -425,25 +553,21 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL); } - scm_mutex_lock (&scm_i_port_table_mutex); + fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), + "file port"); + fp->fdes = fdes; + + port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp); + + SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes); + + if (mode_bits & SCM_BUF0) + scm_fport_buffer_add (port, 0, 0); + else + scm_fport_buffer_add (port, -1, -1); - port = scm_new_port_table_entry (scm_tc16_fport); - SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY(port); - { - scm_t_fport *fp - = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port"); - - fp->fdes = fdes; - pt->rw_random = SCM_FDES_RANDOM_P (fdes); - SCM_SETSTREAM (port, fp); - if (mode_bits & SCM_BUF0) - scm_fport_buffer_add (port, 0, 0); - else - scm_fport_buffer_add (port, -1, -1); - } SCM_SET_FILENAME (port, name); - scm_mutex_unlock (&scm_i_port_table_mutex); + return port; } #undef FUNC_NAME @@ -460,7 +584,19 @@ fport_input_waiting (SCM port) { int fdes = SCM_FSTREAM (port)->fdes; -#ifdef HAVE_SELECT + /* `FD_SETSIZE', which is 1024 on GNU systems, effectively limits the + highest numerical value of file descriptors that can be monitored. + Thus, use poll(2) whenever that is possible. */ + +#ifdef HAVE_POLL + struct pollfd pollfd = { fdes, POLLIN, 0 }; + + if (poll (&pollfd, 1, 0) < 0) + scm_syserror ("fport_input_waiting"); + + return pollfd.revents & POLLIN ? 1 : 0; + +#elif defined(HAVE_SELECT) struct timeval timeout; SELECT_TYPE read_set; SELECT_TYPE write_set; @@ -480,10 +616,15 @@ fport_input_waiting (SCM port) < 0) scm_syserror ("fport_input_waiting"); return FD_ISSET (fdes, &read_set) ? 1 : 0; -#elif defined (FIONREAD) + +#elif HAVE_IOCTL && defined (FIONREAD) + /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD + (for use with winsock ioctlsocket()) but not ioctl(). */ + int fdes = SCM_FSTREAM (port)->fdes; int remir; ioctl(fdes, FIONREAD, &remir); return remir; + #else scm_misc_error ("fport_input_waiting", "Not fully implemented on this platform", @@ -495,7 +636,7 @@ fport_input_waiting (SCM port) static int fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { - scm_puts ("#<", port); + scm_puts_unlocked ("#<", port); scm_print_port_mode (exp, port); if (SCM_OPFPORTP (exp)) { @@ -504,11 +645,11 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) if (scm_is_string (name) || scm_is_symbol (name)) scm_display (name, port); else - scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); - scm_putc (' ', port); + scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); + scm_putc_unlocked (' ', port); fdes = (SCM_FSTREAM (exp))->fdes; - -#ifdef HAVE_TTYNAME + +#if (defined HAVE_TTYNAME) && (defined HAVE_POSIX) if (isatty (fdes)) scm_display (scm_ttyname (exp), port); else @@ -517,60 +658,30 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) } else { - scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); - scm_putc (' ', port); - scm_intprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port); + scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); + scm_putc_unlocked (' ', port); + scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port); } - scm_putc ('>', port); + scm_putc_unlocked ('>', port); return 1; } -#ifndef __MINGW32__ -/* thread-local block for input on fport's fdes. */ -static void -fport_wait_for_input (SCM port) -{ - int fdes = SCM_FSTREAM (port)->fdes; - - if (!fport_input_waiting (port)) - { - int n; - SELECT_TYPE readfds; - int flags = fcntl (fdes, F_GETFL); - - if (flags == -1) - scm_syserror ("scm_fdes_wait_for_input"); - if (!(flags & O_NONBLOCK)) - do - { - FD_ZERO (&readfds); - FD_SET (fdes, &readfds); - n = scm_internal_select (fdes + 1, &readfds, NULL, NULL, NULL); - } - while (n == -1 && errno == EINTR); - } -} -#endif /* !__MINGW32__ */ - static void fport_flush (SCM port); /* fill a port's read-buffer with a single read. returns the first char or EOF if end of file. */ -static int +static scm_t_wchar fport_fill_input (SCM port) { long count; scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); -#ifndef __MINGW32__ - fport_wait_for_input (port); -#endif /* !__MINGW32__ */ SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size)); if (count == -1) scm_syserror ("fport_fill_input"); if (count == 0) - return EOF; + return (scm_t_wchar) EOF; else { pt->read_pos = pt->read_buf; @@ -579,25 +690,25 @@ fport_fill_input (SCM port) } } -static off_t -fport_seek (SCM port, off_t offset, int whence) +static scm_t_off +fport_seek (SCM port, scm_t_off offset, int whence) { scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); - off_t rv; - off_t result; + off_t_or_off64_t rv; + off_t_or_off64_t result; if (pt->rw_active == SCM_PORT_WRITE) { if (offset != 0 || whence != SEEK_CUR) { fport_flush (port); - result = rv = lseek (fp->fdes, offset, whence); + result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); } else { /* read current position without disturbing the buffer. */ - rv = lseek (fp->fdes, offset, whence); + rv = lseek_or_lseek64 (fp->fdes, offset, whence); result = rv + (pt->write_pos - pt->write_buf); } } @@ -606,14 +717,14 @@ fport_seek (SCM port, off_t offset, int whence) if (offset != 0 || whence != SEEK_CUR) { /* could expand to avoid a second seek. */ - scm_end_input (port); - result = rv = lseek (fp->fdes, offset, whence); + scm_end_input_unlocked (port); + result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); } else { /* read current position without disturbing the buffer (particularly the unread-char buffer). */ - rv = lseek (fp->fdes, offset, whence); + rv = lseek_or_lseek64 (fp->fdes, offset, whence); result = rv - (pt->read_end - pt->read_pos); if (pt->read_buf == pt->putback_buf) @@ -622,7 +733,7 @@ fport_seek (SCM port, off_t offset, int whence) } else /* SCM_PORT_NEITHER */ { - result = rv = lseek (fp->fdes, offset, whence); + result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); } if (rv == -1) @@ -632,7 +743,7 @@ fport_seek (SCM port, off_t offset, int whence) } static void -fport_truncate (SCM port, off_t length) +fport_truncate (SCM port, scm_t_off length) { scm_t_fport *fp = SCM_FSTREAM (port); @@ -640,29 +751,9 @@ fport_truncate (SCM port, off_t length) scm_syserror ("ftruncate"); } -/* helper for fport_write: try to write data, using multiple system - calls if required. */ -#define FUNC_NAME "write_all" -static void write_all (SCM port, const void *data, size_t remaining) -{ - int fdes = SCM_FSTREAM (port)->fdes; - - while (remaining > 0) - { - size_t done; - - SCM_SYSCALL (done = write (fdes, data, remaining)); - - if (done == -1) - SCM_SYSERROR; - remaining -= done; - data = ((const char *) data) + done; - } -} -#undef FUNC_NAME - static void fport_write (SCM port, const void *data, size_t size) +#define FUNC_NAME "fport_write" { /* this procedure tries to minimize the number of writes/flushes. */ scm_t_port *pt = SCM_PTAB_ENTRY (port); @@ -670,14 +761,16 @@ fport_write (SCM port, const void *data, size_t size) if (pt->write_buf == &pt->shortbuf || (pt->write_pos == pt->write_buf && size >= pt->write_buf_size)) { - /* "unbuffered" port, or - port with empty buffer and data won't fit in buffer. */ - write_all (port, data, size); + /* Unbuffered port, or port with empty buffer and data won't fit in + buffer. */ + if (full_write (SCM_FPORT_FDES (port), data, size) < size) + SCM_SYSERROR; + return; } { - off_t space = pt->write_end - pt->write_pos; + scm_t_off space = pt->write_end - pt->write_pos; if (size <= space) { @@ -702,7 +795,9 @@ fport_write (SCM port, const void *data, size_t size) if (size >= pt->write_buf_size) { - write_all (port, ptr, remaining); + if (full_write (SCM_FPORT_FDES (port), ptr, remaining) + < remaining) + SCM_SYSERROR; return; } else @@ -718,64 +813,20 @@ fport_write (SCM port, const void *data, size_t size) fport_flush (port); } } - -/* becomes 1 when process is exiting: normal exception handling won't - work by this time. */ -extern int scm_i_terminating; +#undef FUNC_NAME static void fport_flush (SCM port) { + size_t written; scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); - unsigned char *ptr = pt->write_buf; - long init_size = pt->write_pos - pt->write_buf; - long remaining = init_size; - - while (remaining > 0) - { - long count; - - SCM_SYSCALL (count = write (fp->fdes, ptr, remaining)); - if (count < 0) - { - /* error. assume nothing was written this call, but - fix up the buffer for any previous successful writes. */ - long done = init_size - remaining; - - if (done > 0) - { - int i; + size_t count = pt->write_pos - pt->write_buf; - for (i = 0; i < remaining; i++) - { - *(pt->write_buf + i) = *(pt->write_buf + done + i); - } - pt->write_pos = pt->write_buf + remaining; - } - if (scm_i_terminating) - { - const char *msg = "Error: could not flush file-descriptor "; - char buf[11]; + written = full_write (fp->fdes, pt->write_buf, count); + if (written < count) + scm_syserror ("scm_flush"); - write (2, msg, strlen (msg)); - sprintf (buf, "%d\n", fp->fdes); - write (2, buf, strlen (buf)); - - count = remaining; - } - else if (scm_gc_running_p) - { - /* silently ignore the error. scm_error would abort if we - called it now. */ - count = remaining; - } - else - scm_syserror ("fport_flush"); - } - ptr += count; - remaining -= count; - } pt->write_pos = pt->write_buf; pt->rw_active = SCM_PORT_NEITHER; } @@ -861,6 +912,10 @@ scm_init_fports () scm_c_define ("_IOLBF", scm_from_int (_IOLBF)); scm_c_define ("_IONBF", scm_from_int (_IONBF)); + sys_file_port_name_canonicalization = scm_make_fluid (); + scm_c_define ("%file-port-name-canonicalization", + sys_file_port_name_canonicalization); + #include "libguile/fports.x" }