-/* 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
*/
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <stdio.h>
#include <errno.h>
+#include <fcntl.h> /* for chsize on mingw */
+#include <assert.h>
#include <assert.h>
#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"
#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
#include <sys/ioctl.h>
#endif
-#ifdef __MINGW32__
-#include <fcntl.h>
+/* 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
\f
/* 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).
*/
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,
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;
}
}
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;
}
\f
/* 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. */
+\f
+/* 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++;
+ }
+ }
+}
+
+
+\f
+
+/* 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"
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
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;
}
/* 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
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);
}
#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;
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);
}
}
#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
{
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. */
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);
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
*
* 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
*
* 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);
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);
}
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?. */
{
}
#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;
}
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);
{
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
{
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
{
scm_numptob = 0;
scm_ptobs = NULL;
-
- scm_i_port_table = scm_gc_malloc (scm_i_port_table_room
- * sizeof (scm_t_port *),
- "port-table");
}
\f
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"
}
HCoop / bpt / guile.git / blobdiff