X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/9768e0a96e8513dd8a9b59d25e43bbcb2909a5a2..f0893308461d9586d4fd00d78fd7999a660058ff:/libguile/vports.c diff --git a/libguile/vports.c b/libguile/vports.c index be1fa2c52..75e7df303 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -1,46 +1,26 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009, 2010 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program 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 General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * 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 3 of + * the License, or (at your option) any later version. * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. + * 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. * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * 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 + */ +#ifdef HAVE_CONFIG_H +# include +#endif #include #include @@ -76,20 +56,11 @@ sf_flush (SCM port) scm_t_port *pt = SCM_PTAB_ENTRY (port); SCM stream = SCM_PACK (pt->stream); - if (pt->write_pos > pt->write_buf) - { - /* write the byte. */ - scm_call_1 (SCM_VELTS (stream)[0], SCM_MAKE_CHAR (*pt->write_buf)); - pt->write_pos = pt->write_buf; - - /* flush the output. */ - { - SCM f = SCM_VELTS (stream)[2]; + SCM f = SCM_SIMPLE_VECTOR_REF (stream, 2); + + if (scm_is_true (f)) + scm_call_0 (f); - if (!SCM_FALSEP (f)) - scm_call_0 (f); - } - } } static void @@ -97,7 +68,12 @@ sf_write (SCM port, const void *data, size_t size) { SCM p = SCM_PACK (SCM_STREAM (port)); - scm_call_1 (SCM_VELTS (p)[1], scm_mem2string ((char *) data, size)); + /* DATA is assumed to be a locale-encoded C string, which makes it + hard to reliably pass binary data to a soft port. It can be + achieved by choosing a Latin-1 locale, though, but the recommended + approach is to use an R6RS "custom binary output port" instead. */ + scm_call_1 (SCM_SIMPLE_VECTOR_REF (p, 1), + scm_from_locale_stringn ((char *) data, size)); } /* calling the flush proc (element 2) is in case old code needs it, @@ -110,19 +86,26 @@ sf_fill_input (SCM port) { SCM p = SCM_PACK (SCM_STREAM (port)); SCM ans; + scm_t_port *pt; - ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */ - if (SCM_FALSEP (ans) || SCM_EOF_OBJECT_P (ans)) + ans = scm_call_0 (SCM_SIMPLE_VECTOR_REF (p, 3)); /* get char. */ + if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans)) return EOF; SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); - { - scm_t_port *pt = SCM_PTAB_ENTRY (port); - - *pt->read_buf = SCM_CHAR (ans); - pt->read_pos = pt->read_buf; - pt->read_end = pt->read_buf + 1; - return *pt->read_buf; - } + pt = SCM_PTAB_ENTRY (port); + + if (pt->encoding == NULL) + { + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + *pt->read_buf = SCM_CHAR (ans); + pt->read_pos = pt->read_buf; + pt->read_end = pt->read_buf + 1; + return *pt->read_buf; + } + else + scm_ungetc (SCM_CHAR (ans), port); + return SCM_CHAR (ans); } @@ -130,12 +113,12 @@ static int sf_close (SCM port) { SCM p = SCM_PACK (SCM_STREAM (port)); - SCM f = SCM_VELTS (p)[4]; - if (SCM_FALSEP (f)) + SCM f = SCM_SIMPLE_VECTOR_REF (p, 4); + if (scm_is_false (f)) return 0; f = scm_call_0 (f); errno = 0; - return SCM_FALSEP (f) ? EOF : 0; + return scm_is_false (f) ? EOF : 0; } @@ -143,11 +126,11 @@ static int sf_input_waiting (SCM port) { SCM p = SCM_PACK (SCM_STREAM (port)); - if (SCM_VECTOR_LENGTH (p) >= 6) + if (SCM_SIMPLE_VECTOR_LENGTH (p) >= 6) { - SCM f = SCM_VELTS (p)[5]; - if (SCM_NFALSEP (f)) - return scm_num2int (scm_call_0 (f), SCM_ARGn, NULL); + SCM f = SCM_SIMPLE_VECTOR_REF (p, 5); + if (scm_is_true (f)) + return scm_to_int (scm_call_0 (f)); } /* Default is such that char-ready? for soft ports returns #t, as it did before this extension was implemented. */ @@ -209,18 +192,18 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM z; SCM_VALIDATE_VECTOR (1, pv); - vlen = SCM_VECTOR_LENGTH (pv); + vlen = SCM_SIMPLE_VECTOR_LENGTH (pv); SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME); SCM_VALIDATE_STRING (2, modes); - SCM_DEFER_INTS; + scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); z = scm_new_port_table_entry (scm_tc16_sfport); pt = SCM_PTAB_ENTRY (z); scm_port_non_buffer (pt); - SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes))); + SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_i_mode_bits (modes)); SCM_SETSTREAM (z, SCM_UNPACK (pv)); - SCM_ALLOW_INTS; + scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); return z; } #undef FUNC_NAME @@ -231,7 +214,6 @@ scm_make_sfptob () { scm_t_bits tc = scm_make_port_type ("soft", sf_fill_input, sf_write); - scm_set_port_mark (tc, scm_markstream); scm_set_port_flush (tc, sf_flush); scm_set_port_close (tc, sf_close); scm_set_port_input_waiting (tc, sf_input_waiting);