-/* 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 <uniconv.h>
+#include <unistr.h>
+#include <striconveh.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"
+#include "libguile/eq.h"
#ifdef HAVE_STRING_H
#include <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
/* Standard ports --- current input, output, error, and more(!). */
-static SCM cur_inport_fluid;
-static SCM cur_outport_fluid;
-static SCM cur_errport_fluid;
-static SCM cur_loadport_fluid;
+static SCM cur_inport_fluid = 0;
+static SCM cur_outport_fluid = 0;
+static SCM cur_errport_fluid = 0;
+static SCM cur_loadport_fluid = 0;
SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
(),
"returns the @dfn{standard input} in Unix and C terminology.")
#define FUNC_NAME s_scm_current_input_port
{
- return scm_fluid_ref (cur_inport_fluid);
+ if (cur_inport_fluid)
+ return scm_fluid_ref (cur_inport_fluid);
+ else
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
"Unix and C terminology.")
#define FUNC_NAME s_scm_current_output_port
{
- return scm_fluid_ref (cur_outport_fluid);
+ if (cur_outport_fluid)
+ return scm_fluid_ref (cur_outport_fluid);
+ else
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
"@dfn{standard error} in Unix and C terminology).")
#define FUNC_NAME s_scm_current_error_port
{
- return scm_fluid_ref (cur_errport_fluid);
+ if (cur_errport_fluid)
+ return scm_fluid_ref (cur_errport_fluid);
+ else
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
\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;
SCM_SETSTREAM (port, 0);
SCM_CLR_PORT_OPEN_FLAG (port);
- scm_remove_from_port_table (port);
scm_gc_ports_collected++;
}
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;
- /* XXX (Ludo): Can we use `GC_REALLOC' with
- `GC_MALLOC_ATOMIC'-allocated data? */
- 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;
+ const char *enc;
entry->file_name = SCM_BOOL_F;
entry->rw_active = SCM_PORT_NEITHER;
+ entry->port = z;
+ /* Initialize this port with the thread's current default
+ encoding. */
+ if ((enc = scm_i_get_port_encoding (SCM_BOOL_F)) == NULL)
+ entry->encoding = NULL;
+ else
+ entry->encoding = strdup (enc);
+ entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
- 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);
- entry->port = z;
- 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. */
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)
+ if (p->encoding)
{
- scm_i_port_table[i] = scm_i_port_table[scm_i_port_table_size - 1];
- scm_i_port_table[i]->entry = i;
+ free (p->encoding);
+ p->encoding = NULL;
}
+ scm_gc_free (p, sizeof (scm_t_port), "port");
+
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
*/
static long
-scm_i_mode_bits_n (const char *modes, size_t n)
+scm_i_mode_bits_n (SCM modes)
{
return (SCM_OPN
- | (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
- | ( memchr (modes, 'w', n)
- || memchr (modes, 'a', n)
- || memchr (modes, '+', n) ? SCM_WRTNG : 0)
- | (memchr (modes, '0', n) ? SCM_BUF0 : 0)
- | (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
+ | (scm_i_string_contains_char (modes, 'r')
+ || scm_i_string_contains_char (modes, '+') ? SCM_RDNG : 0)
+ | (scm_i_string_contains_char (modes, 'w')
+ || scm_i_string_contains_char (modes, 'a')
+ || scm_i_string_contains_char (modes, '+') ? SCM_WRTNG : 0)
+ | (scm_i_string_contains_char (modes, '0') ? SCM_BUF0 : 0)
+ | (scm_i_string_contains_char (modes, 'l') ? SCM_BUFLINE : 0));
}
long
scm_mode_bits (char *modes)
{
- return scm_i_mode_bits_n (modes, strlen (modes));
+ return scm_i_mode_bits (scm_from_locale_string (modes));
}
long
if (!scm_is_string (modes))
scm_wrong_type_arg_msg (NULL, 0, modes, "string");
- bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
- scm_i_string_length (modes));
+ bits = scm_i_mode_bits_n (modes);
scm_remember_upto_here_1 (modes);
return bits;
}
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
"characters are available, the end-of-file object is returned.")
#define FUNC_NAME s_scm_read_char
{
- int c;
+ scm_t_wchar c;
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
SCM_VALIDATE_OPINPORT (1, port);
}
#undef FUNC_NAME
+#define SCM_MBCHAR_BUF_SIZE (4)
+
+/* Get one codepoint from a file, using the port's encoding. */
+scm_t_wchar
+scm_getc (SCM port)
+{
+ int c;
+ unsigned int bufcount = 0;
+ char buf[SCM_MBCHAR_BUF_SIZE];
+ scm_t_wchar codepoint = 0;
+ scm_t_uint32 *u32;
+ size_t u32len;
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+ c = scm_get_byte_or_eof (port);
+ if (c == EOF)
+ return (scm_t_wchar) EOF;
+
+ buf[0] = c;
+ bufcount++;
+
+ if (pt->encoding == NULL)
+ {
+ /* The encoding is Latin-1: bytes are characters. */
+ codepoint = (unsigned char) buf[0];
+ goto success;
+ }
+
+ for (;;)
+ {
+ u32 = u32_conv_from_encoding (pt->encoding,
+ (enum iconv_ilseq_handler) pt->ilseq_handler,
+ buf, bufcount, NULL, NULL, &u32len);
+ if (u32 == NULL || u32len == 0)
+ {
+ if (errno == ENOMEM)
+ scm_memory_error ("Input decoding");
+
+ /* Otherwise errno is EILSEQ or EINVAL, so perhaps more
+ bytes are needed. Keep looping. */
+ }
+ else
+ {
+ /* Complete codepoint found. */
+ codepoint = u32[0];
+ free (u32);
+ goto success;
+ }
+
+ if (bufcount == SCM_MBCHAR_BUF_SIZE)
+ {
+ /* We've read several bytes and didn't find a good
+ codepoint. Give up. */
+ goto failure;
+ }
+
+ c = scm_get_byte_or_eof (port);
+
+ if (c == EOF)
+ {
+ /* EOF before a complete character was read. Push it all
+ back and return EOF. */
+ while (bufcount > 0)
+ {
+ /* FIXME: this will probably cause errors in the port column. */
+ scm_unget_byte (buf[bufcount-1], port);
+ bufcount --;
+ }
+ return EOF;
+ }
+
+ if (c == '\n')
+ {
+ /* It is always invalid to have EOL in the middle of a
+ multibyte character. */
+ scm_unget_byte ('\n', port);
+ goto failure;
+ }
+
+ buf[bufcount++] = c;
+ }
+
+ success:
+ switch (codepoint)
+ {
+ 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 codepoint;
+
+ failure:
+ {
+ char *err_buf;
+ SCM err_str = scm_i_make_string (bufcount, &err_buf);
+ memcpy (err_buf, buf, bufcount);
+
+ if (errno == EILSEQ)
+ scm_misc_error (NULL, "input encoding error for ~s: ~s",
+ scm_list_2 (scm_from_locale_string (scm_i_get_port_encoding (port)),
+ err_str));
+ else
+ scm_misc_error (NULL, "input encoding error (invalid) for ~s: ~s\n",
+ scm_list_2 (scm_from_locale_string (scm_i_get_port_encoding (port)),
+ err_str));
+ }
+
+ /* Never gets here. */
+ return 0;
+}
+
+
/* this should only be called when the read buffer is empty. it
tries to refill the read buffer. it returns the first char from
the port, which is either EOF or *(pt->read_pos). */
{
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)
+
+/* scm_lfwrite
+ *
+ * This function differs from scm_c_write; it updates port line and
+ * column. */
+
+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)
{
- int c;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (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->rw_active == SCM_PORT_READ)
+ scm_end_input (port);
- if (pt->read_pos >= pt->read_end)
- {
- if (scm_fill_input (port) == EOF)
- return EOF;
- }
+ ptob->write (port, ptr, size);
- c = *(pt->read_pos++);
+ for (; size; ptr++, size--)
+ update_port_lf ((scm_t_wchar) (unsigned char) *ptr, port);
- 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;
+ if (pt->rw_random)
+ pt->rw_active = SCM_PORT_WRITE;
}
-void
-scm_putc (char c, SCM port)
+/* 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)
{
- SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
- scm_lfwrite (&c, 1, 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;
-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);
-}
+ if (pt->rw_active == SCM_PORT_READ)
+ scm_end_input (port);
-/* scm_lfwrite
- *
- * This function differs from scm_c_write; it updates port line and
- * column. */
+ if (end == (size_t) (-1))
+ end = size;
+ size = end - start;
-void
-scm_lfwrite (const char *ptr, size_t size, SCM port)
+ /* Note that making a substring will likely take the
+ stringbuf_write_mutex. So, one shouldn't use scm_lfwrite_substr
+ if the stringbuf write mutex may still be held elsewhere. */
+ buf = scm_to_stringn (scm_c_substring (str, start, end), &len,
+ pt->encoding, pt->ilseq_handler);
+ 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)
{
+ 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);
- ptob->write (port, ptr, size);
+ buf = scm_to_stringn (str, &len,
+ pt->encoding, pt->ilseq_handler);
+ ptob->write (port, buf, len);
+ free (buf);
- 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 (i = 0; i < size; i++)
+ {
+ p = scm_i_string_ref (str, i);
+ update_port_lf (p, port);
}
- }
if (pt->rw_random)
pt->rw_active = SCM_PORT_WRITE;
*
* 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);
}
void
-scm_ungetc (int c, SCM port)
-#define FUNC_NAME "scm_ungetc"
+scm_unget_byte (int c, SCM port)
+#define FUNC_NAME "scm_unget_byte"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
+}
+#undef FUNC_NAME
+
+void
+scm_ungetc (scm_t_wchar c, SCM port)
+#define FUNC_NAME "scm_ungetc"
+{
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_wchar *wbuf;
+ SCM str = scm_i_make_wide_string (1, &wbuf);
+ char *buf;
+ size_t len;
+ int i;
+
+ wbuf[0] = c;
+ buf = scm_to_stringn (str, &len, pt->encoding, pt->ilseq_handler);
+
+ for (i = len - 1; i >= 0; i--)
+ scm_unget_byte (buf[i], port);
if (c == '\n')
{
"to @code{read-char} would have hung.")
#define FUNC_NAME s_scm_peek_char
{
- int c, column;
+ scm_t_wchar c, column;
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
else
"@var{port} is not supplied, the current-input-port is used.")
#define FUNC_NAME s_scm_unread_string
{
+ int n;
SCM_VALIDATE_STRING (1, str);
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
else
SCM_VALIDATE_OPINPORT (2, port);
- scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
+ n = scm_i_string_length (str);
+
+ while (n--)
+ scm_ungetc (scm_i_string_ref (str, n), port);
return str;
}
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
}
#undef FUNC_NAME
+/* The default port encoding for this locale. New ports will have this
+ encoding. If it is a string, that is the encoding. If it #f, it
+ is in the native (Latin-1) encoding. */
+SCM_GLOBAL_VARIABLE (scm_port_encoding_var, "%port-encoding");
+static int scm_port_encoding_init = 0;
+
+/* Return a C string representation of the current encoding. */
+const char *
+scm_i_get_port_encoding (SCM port)
+{
+ SCM encoding;
+
+ if (scm_is_false (port))
+ {
+ if (!scm_port_encoding_init)
+ return NULL;
+ else if (!scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+ return NULL;
+ else
+ {
+ encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_port_encoding_var));
+ if (!scm_is_string (encoding))
+ return NULL;
+ else
+ return scm_i_string_chars (encoding);
+ }
+ }
+ else
+ {
+ scm_t_port *pt;
+ pt = SCM_PTAB_ENTRY (port);
+ if (pt->encoding)
+ return pt->encoding;
+ else
+ return NULL;
+ }
+}
+
+/* Returns ENC is if is a recognized encoding. If it isn't, it tries
+ to find an alias of ENC that is valid. Otherwise, it returns
+ NULL. */
+static const char *
+find_valid_encoding (const char *enc)
+{
+ int isvalid = 0;
+ const char str[] = " ";
+ scm_t_uint32 *u32;
+ size_t u32len;
+
+ u32 = u32_conv_from_encoding (enc, iconveh_error, str, 1,
+ NULL, NULL, &u32len);
+ isvalid = (u32 != NULL);
+ free (u32);
+
+ if (isvalid)
+ return enc;
+
+ return NULL;
+}
+
+void
+scm_i_set_port_encoding_x (SCM port, const char *enc)
+{
+ const char *valid_enc;
+ scm_t_port *pt;
+
+ /* Null is shorthand for the native, Latin-1 encoding. */
+ if (enc == NULL)
+ valid_enc = NULL;
+ else
+ {
+ valid_enc = find_valid_encoding (enc);
+ if (valid_enc == NULL)
+ {
+ SCM err;
+ err = scm_from_locale_string (enc);
+ scm_misc_error (NULL, "invalid or unknown character encoding ~s",
+ scm_list_1 (err));
+ }
+ }
+
+ if (scm_is_false (port))
+ {
+ /* Set the default encoding for future ports. */
+ if (!scm_port_encoding_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+ scm_misc_error (NULL, "tried to set port encoding fluid before it is initialized",
+ SCM_EOL);
+
+ if (valid_enc == NULL
+ || !strcmp (valid_enc, "ASCII")
+ || !strcmp (valid_enc, "ANSI_X3.4-1968")
+ || !strcmp (valid_enc, "ISO-8859-1"))
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+ else
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var),
+ scm_from_locale_string (valid_enc));
+ }
+ else
+ {
+ /* Set the character encoding for this port. */
+ pt = SCM_PTAB_ENTRY (port);
+ if (pt->encoding)
+ free (pt->encoding);
+ if (valid_enc == NULL)
+ pt->encoding = NULL;
+ else
+ pt->encoding = strdup (valid_enc);
+ }
+}
+
+SCM_DEFINE (scm_port_encoding, "port-encoding", 1, 0, 0,
+ (SCM port),
+ "Returns, as a string, the character encoding that @var{port}\n"
+ "uses to interpret its input and output.\n")
+#define FUNC_NAME s_scm_port_encoding
+{
+ scm_t_port *pt;
+ const char *enc;
+
+ SCM_VALIDATE_PORT (1, port);
+
+ pt = SCM_PTAB_ENTRY (port);
+ enc = scm_i_get_port_encoding (port);
+ if (enc)
+ return scm_from_locale_string (pt->encoding);
+ else
+ return scm_from_locale_string ("NONE");
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
+ (SCM port, SCM enc),
+ "Sets the character encoding that will be used to interpret all\n"
+ "port I/O. New ports are created with the encoding\n"
+ "appropriate for the current locale if @code{setlocale} has \n"
+ "been called or ISO-8859-1 otherwise\n"
+ "and this procedure can be used to modify that encoding.\n")
+
+#define FUNC_NAME s_scm_set_port_encoding_x
+{
+ char *enc_str;
+ const char *valid_enc_str;
+
+ SCM_VALIDATE_PORT (1, port);
+ SCM_VALIDATE_STRING (2, enc);
+
+ enc_str = scm_to_locale_string (enc);
+ valid_enc_str = find_valid_encoding (enc_str);
+ if (valid_enc_str == NULL)
+ {
+ free (enc_str);
+ scm_misc_error (FUNC_NAME, "invalid or unknown character encoding ~s",
+ scm_list_1 (enc));
+ }
+ else
+ {
+ scm_i_set_port_encoding_x (port, valid_enc_str);
+ free (enc_str);
+ }
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* This determines how conversions handle unconvertible characters. */
+SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+static int scm_conversion_strategy_init = 0;
+
+scm_t_string_failed_conversion_handler
+scm_i_get_conversion_strategy (SCM port)
+{
+ SCM encoding;
+
+ if (scm_is_false (port))
+ {
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+ return SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else
+ {
+ encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
+ if (scm_is_false (encoding))
+ return SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else
+ return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
+ }
+ }
+ else
+ {
+ scm_t_port *pt;
+ pt = SCM_PTAB_ENTRY (port);
+ return pt->ilseq_handler;
+ }
+
+}
+
+void
+scm_i_set_conversion_strategy_x (SCM port,
+ scm_t_string_failed_conversion_handler handler)
+{
+ SCM strategy;
+ scm_t_port *pt;
+
+ strategy = scm_from_int ((int) handler);
+
+ if (scm_is_false (port))
+ {
+ /* Set the default encoding for future ports. */
+ if (!scm_conversion_strategy
+ || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+ scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+ SCM_EOL);
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
+ }
+ else
+ {
+ /* Set the character encoding for this port. */
+ pt = SCM_PTAB_ENTRY (port);
+ pt->ilseq_handler = handler;
+ }
+}
+
+SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
+ 1, 0, 0, (SCM port),
+ "Returns the behavior of the port when handling a character that\n"
+ "is not representable in the port's current encoding.\n"
+ "It returns the symbol @code{error} if unrepresentable characters\n"
+ "should cause exceptions, @code{substitute} if the port should\n"
+ "try to replace unrepresentable characters with question marks or\n"
+ "approximate characters, or @code{escape} if unrepresentable\n"
+ "characters should be converted to string escapes.\n"
+ "\n"
+ "If @var{port} is @code{#f}, then the current default behavior\n"
+ "will be returned. New ports will have this default behavior\n"
+ "when they are created.\n")
+#define FUNC_NAME s_scm_port_conversion_strategy
+{
+ scm_t_string_failed_conversion_handler h;
+
+ SCM_VALIDATE_OPPORT (1, port);
+
+ if (!scm_is_false (port))
+ {
+ SCM_VALIDATE_OPPORT (1, port);
+ }
+
+ h = scm_i_get_conversion_strategy (port);
+ if (h == SCM_FAILED_CONVERSION_ERROR)
+ return scm_from_locale_symbol ("error");
+ else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
+ return scm_from_locale_symbol ("substitute");
+ else if (h == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+ return scm_from_locale_symbol ("escape");
+ else
+ abort ();
+
+ /* Never gets here. */
+ return SCM_UNDEFINED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_port_conversion_strategy_x, "set-port-conversion-strategy!",
+ 2, 0, 0,
+ (SCM port, SCM sym),
+ "Sets the behavior of the interpreter when outputting a character\n"
+ "that is not representable in the port's current encoding.\n"
+ "@var{sym} can be either @code{'error}, @code{'substitute}, or\n"
+ "@code{'escape}. If it is @code{'error}, an error will be thrown\n"
+ "when an unconvertible character is encountered. If it is\n"
+ "@code{'substitute}, then unconvertible characters will \n"
+ "be replaced with approximate characters, or with question marks\n"
+ "if no approximately correct character is available.\n"
+ "If it is @code{'escape},\n"
+ "it will appear as a hex escape when output.\n"
+ "\n"
+ "If @var{port} is an open port, the conversion error behavior\n"
+ "is set for that port. If it is @code{#f}, it is set as the\n"
+ "default behavior for any future ports that get created in\n"
+ "this thread.\n")
+#define FUNC_NAME s_scm_set_port_conversion_strategy_x
+{
+ SCM err;
+ SCM qm;
+ SCM esc;
+
+ if (!scm_is_false (port))
+ {
+ SCM_VALIDATE_OPPORT (1, port);
+ }
+
+ err = scm_from_locale_symbol ("error");
+ if (scm_is_true (scm_eqv_p (sym, err)))
+ {
+ scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
+ return SCM_UNSPECIFIED;
+ }
+
+ qm = scm_from_locale_symbol ("substitute");
+ if (scm_is_true (scm_eqv_p (sym, qm)))
+ {
+ scm_i_set_conversion_strategy_x (port,
+ SCM_FAILED_CONVERSION_QUESTION_MARK);
+ return SCM_UNSPECIFIED;
+ }
+
+ esc = scm_from_locale_symbol ("escape");
+ if (scm_is_true (scm_eqv_p (sym, esc)))
+ {
+ scm_i_set_conversion_strategy_x (port,
+ SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+ return SCM_UNSPECIFIED;
+ }
+
+ SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
void
scm_print_port_mode (SCM exp, SCM port)
{
{
scm_numptob = 0;
scm_ptobs = NULL;
-
- /* In order for the ports to be collectable, the port table must not be
- scanned by the GC. */
- scm_i_port_table =
- scm_gc_malloc_pointerless (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"
+
+ SCM_VARIABLE_SET (scm_port_encoding_var, scm_make_fluid ());
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+ scm_port_encoding_init = 1;
+
+ SCM_VARIABLE_SET (scm_conversion_strategy, scm_make_fluid ());
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy),
+ scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK));
+ scm_conversion_strategy_init = 1;
+
}
/*
HCoop / bpt / guile.git / blobdiff