X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/92d8fd328c66df2132e13ff1428bb83b2f4350c2..fbb857a472eb4e69c1cba05e86646b7004f32df6:/libguile/ports.c diff --git a/libguile/ports.c b/libguile/ports.c index d5f4ee6e6..2d0e26b39 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1,18 +1,19 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ @@ -21,18 +22,21 @@ #define _LARGEFILE64_SOURCE /* ask for stat64 etc */ -#if HAVE_CONFIG_H +#ifdef HAVE_CONFIG_H # include #endif #include #include +#include /* for chsize on mingw */ +#include #include #include "libguile/_scm.h" #include "libguile/async.h" #include "libguile/eval.h" +#include "libguile/fports.h" /* direct access for seek and truncate */ #include "libguile/objects.h" #include "libguile/goops.h" #include "libguile/smob.h" @@ -40,12 +44,14 @@ #include "libguile/dynwind.h" #include "libguile/keywords.h" +#include "libguile/hashtab.h" #include "libguile/root.h" #include "libguile/strings.h" #include "libguile/mallocs.h" #include "libguile/validate.h" #include "libguile/ports.h" #include "libguile/vectors.h" +#include "libguile/weaks.h" #include "libguile/fluids.h" #ifdef HAVE_STRING_H @@ -64,9 +70,17 @@ #include #endif -#ifdef __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 HAVE_CHSIZE && ! HAVE_FTRUNCATE #define ftruncate(fd, size) chsize (fd, size) +#undef HAVE_FTRUNCATE +#define HAVE_FTRUNCATE 1 #endif @@ -74,7 +88,7 @@ /* scm_ptobs scm_numptob - * implement a dynamicly resized array of ptob records. + * implement a dynamically resized array of ptob records. * Indexes into this table are used when generating type * tags for smobjects (if you know a tag you can get an index and conversely). */ @@ -121,7 +135,7 @@ scm_make_port_type (char *name, void (*write) (SCM port, const void *data, size_t size)) { char *tmp; - if (255 <= scm_numptob) + if (SCM_I_MAX_PORT_TYPE_COUNT - 1 <= scm_numptob) goto ptoberr; SCM_CRITICAL_SECTION_START; tmp = (char *) scm_gc_realloc ((char *) scm_ptobs, @@ -159,7 +173,7 @@ scm_make_port_type (char *name, scm_memory_error ("scm_make_port_type"); } /* Make a class object if Goops is present */ - if (scm_port_class) + if (SCM_UNPACK (scm_port_class[0]) != 0) scm_make_port_classes (scm_numptob - 1, SCM_PTOBNAME (scm_numptob - 1)); return scm_tc7_port + (scm_numptob - 1) * 256; } @@ -208,15 +222,14 @@ scm_set_port_close (scm_t_bits tc, int (*close) (SCM)) } void -scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port, - off_t OFFSET, - int WHENCE)) +scm_set_port_seek (scm_t_bits tc, + scm_t_off (*seek) (SCM, scm_t_off, int)) { scm_ptobs[SCM_TC2PTOBNUM (tc)].seek = seek; } void -scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length)) +scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM, scm_t_off)) { scm_ptobs[SCM_TC2PTOBNUM (tc)].truncate = truncate; } @@ -475,15 +488,77 @@ scm_i_dynwind_current_load_port (SCM port) /* The port table --- an array of pointers to ports. */ -scm_t_port **scm_i_port_table = NULL; - -long scm_i_port_table_size = 0; /* Number of ports in SCM_I_PORT_TABLE. */ -long scm_i_port_table_room = 20; /* Actual size of the array. */ +/* + We need a global registry of ports to flush them all at exit, and to + get all the ports matching a file descriptor. + */ +SCM scm_i_port_weak_hash; scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; -/* This function is not and should not be thread safe. */ + +/* Port finalization. */ + + +static void finalize_port (GC_PTR, GC_PTR); + +/* Register a finalizer for PORT, if needed by its port type. */ +static SCM_C_INLINE_KEYWORD void +register_finalizer_for_port (SCM port) +{ + long port_type; + + port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port)); + if (scm_ptobs[port_type].free) + { + GC_finalization_proc prev_finalizer; + GC_PTR prev_finalization_data; + + GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0, + &prev_finalizer, + &prev_finalization_data); + } +} + +/* Finalize the object (a port) pointed to by PTR. */ +static void +finalize_port (GC_PTR ptr, GC_PTR data) +{ + long port_type; + SCM port = PTR2SCM (ptr); + + if (!SCM_PORTP (port)) + abort (); + + if (SCM_OPENP (port)) + { + if (SCM_REVEALED (port) > 0) + /* Keep "revealed" ports alive and re-register a finalizer. */ + register_finalizer_for_port (port); + else + { + port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port)); + if (port_type >= scm_numptob) + abort (); + + if (scm_ptobs[port_type].free) + /* Yes, I really do mean `.free' rather than `.close'. `.close' + is for explicit `close-port' by user. */ + scm_ptobs[port_type].free (port); + + SCM_SETSTREAM (port, 0); + SCM_CLR_PORT_OPEN_FLAG (port); + + scm_gc_ports_collected++; + } + } +} + + + + +/* This function is not and should not be thread safe. */ SCM scm_new_port_table_entry (scm_t_bits tag) #define FUNC_NAME "scm_new_port_table_entry" @@ -495,32 +570,20 @@ scm_new_port_table_entry (scm_t_bits tag) SCM z = scm_cons (SCM_EOL, SCM_EOL); scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port"); - if (scm_i_port_table_size == scm_i_port_table_room) - { - /* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc., - since it can never be freed during gc. */ - /* XXX (Ludo): Why not do it actually? */ - size_t new_size = scm_i_port_table_room * 2; - void *newt = scm_gc_realloc ((char *) scm_i_port_table, - scm_i_port_table_room * sizeof (scm_t_port *), - new_size * sizeof (scm_t_port *), - "port-table"); - scm_i_port_table = (scm_t_port **) newt; - scm_i_port_table_room = new_size; - } - - entry->entry = scm_i_port_table_size; entry->file_name = SCM_BOOL_F; entry->rw_active = SCM_PORT_NEITHER; + entry->port = z; - scm_i_port_table[scm_i_port_table_size] = entry; - scm_i_port_table_size++; + SCM_SET_CELL_TYPE (z, tag); + SCM_SETPTAB_ENTRY (z, entry); + + scm_hashq_set_x (scm_i_port_weak_hash, z, SCM_BOOL_F); + + /* For each new port, register a finalizer so that it port type's free + function can be invoked eventually. */ + register_finalizer_for_port (z); - entry->port = z; - SCM_SET_CELL_TYPE(z, tag); - SCM_SETPTAB_ENTRY(z, entry); - return z; } #undef FUNC_NAME @@ -533,8 +596,8 @@ scm_add_to_port_table (SCM port) scm_t_port * pt = SCM_PTAB_ENTRY(z); pt->port = port; - SCM_SETCAR(z, SCM_EOL); - SCM_SETCDR(z, SCM_EOL); + SCM_SETCAR (z, SCM_EOL); + SCM_SETCDR (z, SCM_EOL); SCM_SETPTAB_ENTRY (port, pt); return pt; } @@ -544,57 +607,30 @@ scm_add_to_port_table (SCM port) /* Remove a port from the table and destroy it. */ /* This function is not and should not be thread safe. */ - void -scm_remove_from_port_table (SCM port) -#define FUNC_NAME "scm_remove_from_port_table" +scm_i_remove_port (SCM port) +#define FUNC_NAME "scm_remove_port" { scm_t_port *p = SCM_PTAB_ENTRY (port); - long i = p->entry; - - if (i >= scm_i_port_table_size) - SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port)); if (p->putback_buf) scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer"); scm_gc_free (p, sizeof (scm_t_port), "port"); - /* Since we have just freed slot i we can shrink the table by moving - the last entry to that slot... */ - if (i < scm_i_port_table_size - 1) - { - scm_i_port_table[i] = scm_i_port_table[scm_i_port_table_size - 1]; - scm_i_port_table[i]->entry = i; - } + SCM_SETPTAB_ENTRY (port, 0); - scm_i_port_table_size--; + scm_hashq_remove_x (scm_i_port_weak_hash, port); } #undef FUNC_NAME -#ifdef GUILE_DEBUG /* Functions for debugging. */ - +#ifdef GUILE_DEBUG SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0, (), "Return the number of ports in the port table. @code{pt-size}\n" "is only included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_pt_size { - return scm_from_int (scm_i_port_table_size); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0, - (SCM index), - "Return the port at @var{index} in the port table.\n" - "@code{pt-member} is only included in\n" - "@code{--enable-guile-debug} builds.") -#define FUNC_NAME s_scm_pt_member -{ - size_t i = scm_to_size_t (index); - if (i >= scm_i_port_table_size) - return SCM_BOOL_F; - else - return scm_i_port_table[i]->port; + return scm_from_int (SCM_HASHTABLE_N_ITEMS (scm_i_port_weak_hash)); } #undef FUNC_NAME #endif @@ -755,7 +791,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0, else rv = 0; scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); - scm_remove_from_port_table (port); + scm_i_remove_port (port); scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); SCM_CLR_PORT_OPEN_FLAG (port); return scm_from_bool (rv >= 0); @@ -793,10 +829,20 @@ SCM_DEFINE (scm_close_output_port, "close-output-port", 1, 0, 0, } #undef FUNC_NAME +static SCM +scm_i_collect_keys_in_vector (void *closure, SCM key, SCM value, SCM result) +{ + int *i = (int*) closure; + scm_c_vector_set_x (result, *i, key); + (*i)++; + + return result; +} + void scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data) { - long i; + int i = 0; size_t n; SCM ports; @@ -806,20 +852,20 @@ scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data) collect the ports into a vector. -mvo */ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); - n = scm_i_port_table_size; + n = SCM_HASHTABLE_N_ITEMS (scm_i_port_weak_hash); scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); - ports = scm_c_make_vector (n, SCM_BOOL_F); - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); - if (n > scm_i_port_table_size) - n = scm_i_port_table_size; - for (i = 0; i < n; i++) - SCM_SIMPLE_VECTOR_SET (ports, i, scm_i_port_table[i]->port); + scm_i_pthread_mutex_lock (&scm_i_port_table_mutex); + ports = scm_internal_hash_fold (scm_i_collect_keys_in_vector, &i, + ports, scm_i_port_weak_hash); scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); - for (i = 0; i < n; i++) - proc (data, SCM_SIMPLE_VECTOR_REF (ports, i)); + for (i = 0; i < n; i++) { + SCM p = SCM_SIMPLE_VECTOR_REF (ports, i); + if (SCM_PORTP (p)) + proc (data, p); + } scm_remember_upto_here_1 (ports); } @@ -922,21 +968,21 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0, } #undef FUNC_NAME + +static void +flush_output_port (void *closure, SCM port) +{ + if (SCM_OPOUTPORTP (port)) + scm_flush (port); +} + SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0, (), "Equivalent to calling @code{force-output} on\n" "all open output ports. The return value is unspecified.") #define FUNC_NAME s_scm_flush_all_ports { - size_t i; - - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); - for (i = 0; i < scm_i_port_table_size; i++) - { - if (SCM_OPOUTPORTP (scm_i_port_table[i]->port)) - scm_flush (scm_i_port_table[i]->port); - } - scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); + scm_c_port_for_each (&flush_output_port, NULL); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -967,6 +1013,8 @@ scm_fill_input (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); + assert (pt->read_pos == pt->read_end); + if (pt->read_buf == pt->putback_buf) { /* finished reading put-back chars. */ @@ -980,71 +1028,30 @@ scm_fill_input (SCM port) return scm_ptobs[SCM_PTOBNUM (port)].fill_input (port); } -int -scm_getc (SCM port) -{ - int c; - scm_t_port *pt = SCM_PTAB_ENTRY (port); - - if (pt->rw_active == SCM_PORT_WRITE) - /* may be marginally faster than calling scm_flush. */ - scm_ptobs[SCM_PTOBNUM (port)].flush (port); - - if (pt->rw_random) - pt->rw_active = SCM_PORT_READ; - - if (pt->read_pos >= pt->read_end) - { - if (scm_fill_input (port) == EOF) - return EOF; - } - - c = *(pt->read_pos++); - - switch (c) - { - case '\a': - break; - case '\b': - SCM_DECCOL (port); - break; - case '\n': - SCM_INCLINE (port); - break; - case '\r': - SCM_ZEROCOL (port); - break; - case '\t': - SCM_TABCOL (port); - break; - default: - SCM_INCCOL (port); - break; - } - - return c; -} - -void -scm_putc (char c, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (&c, 1, port); -} - -void -scm_puts (const char *s, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (s, strlen (s), port); -} /* scm_lfwrite * * This function differs from scm_c_write; it updates port line and * column. */ -void +static void +update_port_lf (scm_t_wchar c, SCM port) +{ + if (c == '\a') + ; /* Do nothing. */ + else if (c == '\b') + SCM_DECCOL (port); + else if (c == '\n') + SCM_INCLINE (port); + else if (c == '\r') + SCM_ZEROCOL (port); + else if (c == '\t') + SCM_TABCOL (port); + else + SCM_INCCOL (port); +} + +void scm_lfwrite (const char *ptr, size_t size, SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); @@ -1055,30 +1062,54 @@ scm_lfwrite (const char *ptr, size_t size, SCM port) ptob->write (port, ptr, size); - for (; size; ptr++, size--) { - if (*ptr == '\a') { - } - else if (*ptr == '\b') { - SCM_DECCOL(port); - } - else if (*ptr == '\n') { - SCM_INCLINE(port); - } - else if (*ptr == '\r') { - SCM_ZEROCOL(port); - } - else if (*ptr == '\t') { - SCM_TABCOL(port); - } - else { - SCM_INCCOL(port); + for (; size; ptr++, size--) + update_port_lf ((scm_t_wchar) (unsigned char) *ptr, port); + + if (pt->rw_random) + pt->rw_active = SCM_PORT_WRITE; +} + +/* Write a scheme string STR to PORT from START inclusive to END + exclusive. */ +void +scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM port) +{ + size_t i, size = scm_i_string_length (str); + scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_t_wchar p; + char *buf; + size_t len; + + if (pt->rw_active == SCM_PORT_READ) + scm_end_input (port); + + if (end == (size_t) (-1)) + end = size; + size = end - start; + + buf = scm_to_stringn (scm_c_substring (str, start, end), &len, + NULL, SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE); + ptob->write (port, buf, len); + free (buf); + + for (i = 0; i < size; i++) + { + p = scm_i_string_ref (str, i + start); + update_port_lf (p, port); } - } if (pt->rw_random) pt->rw_active = SCM_PORT_WRITE; } +/* Write a scheme string STR to PORT. */ +void +scm_lfwrite_str (SCM str, SCM port) +{ + scm_lfwrite_substr (str, 0, (size_t) (-1), port); +} + /* scm_c_read * * Used by an application to read arbitrary number of bytes from an @@ -1087,48 +1118,121 @@ scm_lfwrite (const char *ptr, size_t size, SCM port) * * Warning: Doesn't update port line and column counts! */ +/* This structure, and the following swap_buffer function, are used + for temporarily swapping a port's own read buffer, and the buffer + that the caller of scm_c_read provides. */ +struct port_and_swap_buffer +{ + scm_t_port *pt; + unsigned char *buffer; + size_t size; +}; + +static void +swap_buffer (void *data) +{ + struct port_and_swap_buffer *psb = (struct port_and_swap_buffer *) data; + unsigned char *old_buf = psb->pt->read_buf; + size_t old_size = psb->pt->read_buf_size; + + /* Make the port use (buffer, size) from the struct. */ + psb->pt->read_pos = psb->pt->read_buf = psb->pt->read_end = psb->buffer; + psb->pt->read_buf_size = psb->size; + + /* Save the port's old (buffer, size) in the struct. */ + psb->buffer = old_buf; + psb->size = old_size; +} + size_t scm_c_read (SCM port, void *buffer, size_t size) +#define FUNC_NAME "scm_c_read" { - scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_t_port *pt; size_t n_read = 0, n_available; + struct port_and_swap_buffer psb; + + SCM_VALIDATE_OPINPORT (1, port); + pt = SCM_PTAB_ENTRY (port); if (pt->rw_active == SCM_PORT_WRITE) scm_ptobs[SCM_PTOBNUM (port)].flush (port); if (pt->rw_random) pt->rw_active = SCM_PORT_READ; - if (SCM_READ_BUFFER_EMPTY_P (pt)) - { - if (scm_fill_input (port) == EOF) - return 0; - } - - n_available = pt->read_end - pt->read_pos; - - while (n_available < size) + /* Take bytes first from the port's read buffer. */ + if (pt->read_pos < pt->read_end) { + n_available = min (size, pt->read_end - pt->read_pos); memcpy (buffer, pt->read_pos, n_available); buffer = (char *) buffer + n_available; pt->read_pos += n_available; n_read += n_available; - - if (SCM_READ_BUFFER_EMPTY_P (pt)) + size -= n_available; + } + + /* Avoid the scm_dynwind_* costs if we now have enough data. */ + if (size == 0) + return n_read; + + /* Now we will call scm_fill_input repeatedly until we have read the + requested number of bytes. (Note that a single scm_fill_input + call does not guarantee to fill the whole of the port's read + buffer.) */ + if (pt->read_buf_size <= 1) + { + /* The port that we are reading from is unbuffered - i.e. does + not have its own persistent buffer - but we have a buffer, + provided by our caller, that is the right size for the data + that is wanted. For the following scm_fill_input calls, + therefore, we use the buffer in hand as the port's read + buffer. + + We need to make sure that the port's normal (1 byte) buffer + is reinstated in case one of the scm_fill_input () calls + throws an exception; we use the scm_dynwind_* API to achieve + that. */ + psb.pt = pt; + psb.buffer = buffer; + psb.size = size; + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); + scm_dynwind_rewind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY); + scm_dynwind_unwind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY); + + /* Call scm_fill_input until we have all the bytes that we need, + or we hit EOF. */ + while (pt->read_buf_size && (scm_fill_input (port) != EOF)) { - if (scm_fill_input (port) == EOF) - return n_read; + pt->read_buf_size -= (pt->read_end - pt->read_pos); + pt->read_pos = pt->read_buf = pt->read_end; } + n_read += pt->read_buf - (unsigned char *) buffer; - size -= n_available; - n_available = pt->read_end - pt->read_pos; + /* Reinstate the port's normal buffer. */ + scm_dynwind_end (); + } + else + { + /* The port has its own buffer. It is important that we use it, + even if it happens to be smaller than our caller's buffer, so + that a custom port implementation's entry points (in + particular, fill_input) can rely on the buffer always being + the same as they first set up. */ + while (size && (scm_fill_input (port) != EOF)) + { + n_available = min (size, pt->read_end - pt->read_pos); + memcpy (buffer, pt->read_pos, n_available); + buffer = (char *) buffer + n_available; + pt->read_pos += n_available; + n_read += n_available; + size -= n_available; + } } - memcpy (buffer, pt->read_pos, size); - pt->read_pos += size; - - return n_read + size; + return n_read; } +#undef FUNC_NAME /* scm_c_write * @@ -1140,11 +1244,17 @@ scm_c_read (SCM port, void *buffer, size_t size) * Warning: Doesn't update port line and column counts! */ -void +void scm_c_write (SCM port, const void *ptr, size_t size) +#define FUNC_NAME "scm_c_write" { - scm_t_port *pt = SCM_PTAB_ENTRY (port); - scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_t_port *pt; + scm_t_ptob_descriptor *ptob; + + SCM_VALIDATE_OPOUTPORT (1, port); + + pt = SCM_PTAB_ENTRY (port); + ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (pt->rw_active == SCM_PORT_READ) scm_end_input (port); @@ -1154,12 +1264,13 @@ scm_c_write (SCM port, const void *ptr, size_t size) if (pt->rw_random) pt->rw_active = SCM_PORT_WRITE; } +#undef FUNC_NAME void scm_flush (SCM port) { long i = SCM_PTOBNUM (port); - assert ((i >= 0) && (i < scm_i_port_table_size)); + assert (i >= 0); (scm_ptobs[i].flush) (port); } @@ -1391,15 +1502,15 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, if (SCM_OPPORTP (fd_port)) { scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port); - off_t off = scm_to_off_t (offset); - off_t rv; + off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset); + off_t_or_off64_t rv; if (!ptob->seek) SCM_MISC_ERROR ("port is not seekable", scm_cons (fd_port, SCM_EOL)); else rv = ptob->seek (fd_port, off, how); - return scm_from_off_t (rv); + return scm_from_off_t_or_off64_t (rv); } else /* file descriptor?. */ { @@ -1413,28 +1524,48 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, } #undef FUNC_NAME -#ifdef __MINGW32__ -/* Define this function since it is not supported under Windows. */ -static int truncate (char *file, int length) +#ifndef O_BINARY +#define O_BINARY 0 +#endif + +/* Mingw has ftruncate(), perhaps implemented above using chsize, but + doesn't have the filename version truncate(), hence this code. */ +#if HAVE_FTRUNCATE && ! HAVE_TRUNCATE +static int +truncate (const char *file, off_t length) { - int ret = -1, fdes; - if ((fdes = open (file, O_BINARY | O_WRONLY)) != -1) + int ret, fdes; + + fdes = open (file, O_BINARY | O_WRONLY); + if (fdes == -1) + return -1; + + ret = ftruncate (fdes, length); + if (ret == -1) { - ret = chsize (fdes, length); + int save_errno = errno; close (fdes); + errno = save_errno; + return -1; } - return ret; + + return close (fdes); } -#endif /* __MINGW32__ */ +#endif /* HAVE_FTRUNCATE && ! HAVE_TRUNCATE */ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, (SCM object, SCM length), - "Truncates the object referred to by @var{object} to at most\n" - "@var{length} bytes. @var{object} can be a string containing a\n" - "file name or an integer file descriptor or a port.\n" - "@var{length} may be omitted if @var{object} is not a file name,\n" - "in which case the truncation occurs at the current port\n" - "position. The return value is unspecified.") + "Truncate @var{file} to @var{length} bytes. @var{file} can be a\n" + "filename string, a port object, or an integer file descriptor.\n" + "The return value is unspecified.\n" + "\n" + "For a port or file descriptor @var{length} can be omitted, in\n" + "which case the file is truncated at the current position (per\n" + "@code{ftell} above).\n" + "\n" + "On most systems a file can be extended by giving a length\n" + "greater than the current size, but this is not mandatory in the\n" + "POSIX standard.") #define FUNC_NAME s_scm_truncate_file { int rv; @@ -1463,7 +1594,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, } else if (SCM_OPOUTPORTP (object)) { - off_t c_length = scm_to_off_t (length); + off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length); scm_t_port *pt = SCM_PTAB_ENTRY (object); scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); @@ -1505,7 +1636,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return scm_from_int (SCM_LINUM (port)); + return scm_from_long (SCM_LINUM (port)); } #undef FUNC_NAME @@ -1517,7 +1648,7 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - SCM_PTAB_ENTRY (port)->line_number = scm_to_int (line); + SCM_PTAB_ENTRY (port)->line_number = scm_to_long (line); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -1617,10 +1748,6 @@ scm_ports_prehistory () { scm_numptob = 0; scm_ptobs = NULL; - - scm_i_port_table = scm_gc_malloc (scm_i_port_table_room - * sizeof (scm_t_port *), - "port-table"); } @@ -1695,6 +1822,8 @@ scm_init_ports () cur_errport_fluid = scm_permanent_object (scm_make_fluid ()); cur_loadport_fluid = scm_permanent_object (scm_make_fluid ()); + scm_i_port_weak_hash = scm_permanent_object (scm_make_weak_key_hash_table (SCM_I_MAKINUM(31))); + #include "libguile/ports.x" }