X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/478848cb706b23bcc4c2afe9a4ad33c595bc33f6..8c6206f319971fc61df9a7362ad0253bb47349bd:/libguile/strports.c diff --git a/libguile/strports.c b/libguile/strports.c index 649c2477e..a6a03b4eb 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006, - * 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012, 2013, 2014 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 @@ -27,9 +27,7 @@ #include "libguile/_scm.h" #include -#ifdef HAVE_UNISTD_H #include -#endif #include "libguile/bytevectors.h" #include "libguile/eval.h" @@ -57,10 +55,8 @@ /* NOTES: write_buf/write_end point to the ends of the allocated bytevector. - read_buf/read_end in principle point to the part of the bytevector which - has been written to, but this is only updated after a flush. - read_pos and write_pos in principle should be equal, but this is only true - when rw_active is SCM_PORT_NEITHER. + read_buf/read_end point to the part of the bytevector which has been + written to. read_pos and write_pos are always equal. ENHANCE-ME - output blocks: @@ -90,14 +86,14 @@ scm_t_bits scm_tc16_strport; static int -stfill_buffer (SCM port) +st_fill_input (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); if (pt->read_pos >= pt->read_end) return EOF; else - return scm_return_first_int (*pt->read_pos, port); + return *pt->read_pos; } /* Change the size of a port's bytevector to NEW_SIZE. This doesn't @@ -112,7 +108,7 @@ st_resize_port (scm_t_port *pt, scm_t_off new_size) unsigned long int old_size = SCM_BYTEVECTOR_LENGTH (old_stream); unsigned long int min_size = min (old_size, new_size); - scm_t_off index = pt->write_pos - pt->write_buf; + scm_t_off offset = pt->write_pos - pt->write_buf; pt->write_buf_size = new_size; @@ -124,50 +120,29 @@ st_resize_port (scm_t_port *pt, scm_t_off new_size) { pt->stream = SCM_UNPACK (new_stream); pt->read_buf = pt->write_buf = (unsigned char *)dst; - pt->read_pos = pt->write_pos = pt->write_buf + index; + pt->read_pos = pt->write_pos = pt->write_buf + offset; pt->write_end = pt->write_buf + pt->write_buf_size; pt->read_end = pt->read_buf + pt->read_buf_size; } } -/* Ensure that `write_pos' < `write_end' by enlarging the buffer when - necessary. Update `read_buf' to account for written chars. The - buffer is enlarged geometrically. */ static void -st_flush (SCM port) +st_write (SCM port, const void *data, size_t size) { scm_t_port *pt = SCM_PTAB_ENTRY (port); - if (pt->write_pos == pt->write_end) - st_resize_port (pt, pt->write_buf_size * 2); + if (size > pt->write_end - pt->write_pos) + st_resize_port (pt, max (pt->write_buf_size * 2, + pt->write_end - pt->write_pos + size)); + + memcpy ((char *) pt->write_pos, data, size); + pt->read_pos = (pt->write_pos += size); - pt->read_pos = pt->write_pos; if (pt->read_pos > pt->read_end) { pt->read_end = (unsigned char *) pt->read_pos; pt->read_buf_size = pt->read_end - pt->read_buf; } - pt->rw_active = SCM_PORT_NEITHER; -} - -static void -st_write (SCM port, const void *data, size_t size) -{ - scm_t_port *pt = SCM_PTAB_ENTRY (port); - const char *input = (char *) data; - - while (size > 0) - { - int space = pt->write_end - pt->write_pos; - int write_len = (size > space) ? space : size; - - memcpy ((char *) pt->write_pos, input, write_len); - pt->write_pos += write_len; - size -= write_len; - input += write_len; - if (write_len == space) - st_flush (port); - } } static void @@ -204,11 +179,10 @@ st_seek (SCM port, scm_t_off offset, int whence) else /* all other cases. */ { - if (pt->rw_active == SCM_PORT_WRITE) - st_flush (port); - if (pt->rw_active == SCM_PORT_READ) - scm_end_input (port); + scm_end_input_unlocked (port); + + pt->rw_active = SCM_PORT_NEITHER; switch (whence) { @@ -261,10 +235,7 @@ st_truncate (SCM port, scm_t_off length) pt->read_buf_size = length; pt->read_end = pt->read_buf + length; if (pt->read_pos > pt->read_end) - pt->read_pos = pt->read_end; - - if (pt->write_pos > pt->read_end) - pt->write_pos = pt->read_end; + pt->read_pos = pt->write_pos = pt->read_end; } /* The initial size in bytes of a string port's buffer. */ @@ -278,66 +249,63 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) { SCM z, buf; scm_t_port *pt; - size_t str_len, c_pos; + size_t read_buf_size, num_bytes, c_byte_pos; char *c_buf; if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); - scm_dynwind_begin (0); - scm_i_dynwind_pthread_mutex_lock (&scm_i_port_table_mutex); - - z = scm_new_port_table_entry (scm_tc16_strport); - pt = SCM_PTAB_ENTRY(z); - if (scm_is_false (str)) { /* Allocate a new buffer to write to. */ - str_len = INITIAL_BUFFER_SIZE; - buf = scm_c_make_bytevector (str_len); + num_bytes = INITIAL_BUFFER_SIZE; + buf = scm_c_make_bytevector (num_bytes); c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); /* Reset `read_buf_size'. It will contain the actual number of - bytes written to PT. */ - pt->read_buf_size = 0; - c_pos = 0; + bytes written to the port. */ + read_buf_size = 0; + c_byte_pos = 0; } else { - /* STR is a string. */ char *copy; SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); - /* Create a copy of STR in the encoding of PT. */ - copy = scm_to_stringn (str, &str_len, pt->encoding, - SCM_FAILED_CONVERSION_ERROR); - buf = scm_c_make_bytevector (str_len); + /* STR is a string. */ + /* Create a copy of STR in UTF-8. */ + copy = scm_to_utf8_stringn (str, &num_bytes); + buf = scm_c_make_bytevector (num_bytes); c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); - memcpy (c_buf, copy, str_len); + memcpy (c_buf, copy, num_bytes); free (copy); - c_pos = scm_to_unsigned_integer (pos, 0, str_len); - pt->read_buf_size = str_len; + read_buf_size = num_bytes; + + if (scm_is_eq (pos, SCM_INUM0)) + c_byte_pos = 0; + else + /* Inefficient but simple way to convert the character position + POS into a byte position C_BYTE_POS. */ + free (scm_to_utf8_stringn (scm_substring (str, SCM_INUM0, pos), + &c_byte_pos)); } - SCM_SETSTREAM (z, SCM_UNPACK (buf)); - SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); + z = scm_c_make_port_with_encoding (scm_tc16_strport, modes, + "UTF-8", + scm_i_default_port_conversion_handler (), + SCM_UNPACK (buf)); + + pt = SCM_PTAB_ENTRY (z); pt->write_buf = pt->read_buf = (unsigned char *) c_buf; - pt->read_pos = pt->write_pos = pt->read_buf + c_pos; - pt->write_buf_size = str_len; + pt->read_pos = pt->write_pos = pt->read_buf + c_byte_pos; + pt->read_buf_size = read_buf_size; + pt->write_buf_size = num_bytes; pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; - pt->rw_random = 1; - scm_dynwind_end (); - - /* Ensure WRITE_POS is writable. */ - if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end) - st_flush (z); - - pt->ilseq_handler = SCM_FAILED_CONVERSION_ERROR; return z; } @@ -346,26 +314,12 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) SCM scm_strport_to_string (SCM port) { - SCM str; scm_t_port *pt = SCM_PTAB_ENTRY (port); - if (pt->rw_active == SCM_PORT_WRITE) - st_flush (port); - if (pt->read_buf_size == 0) return scm_nullstr; - if (pt->encoding == NULL) - { - char *buf; - str = scm_i_make_string (pt->read_buf_size, &buf, 0); - memcpy (buf, pt->read_buf, pt->read_buf_size); - } - else - str = scm_from_stringn ((char *)pt->read_buf, pt->read_buf_size, - pt->encoding, pt->ilseq_handler); - scm_remember_upto_here_1 (port); - return str; + return scm_from_port_stringn ((char *)pt->read_buf, pt->read_buf_size, port); } SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, @@ -402,35 +356,27 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, - (SCM proc), - "Calls the one-argument procedure @var{proc} with a newly created output\n" - "port. When the function returns, the string composed of the characters\n" - "written into the port is returned.") -#define FUNC_NAME s_scm_call_with_output_string +SCM +scm_call_with_output_string (SCM proc) { - SCM p; + static SCM var = SCM_BOOL_F; - p = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, - SCM_OPN | SCM_WRTNG, - FUNC_NAME); - scm_call_1 (proc, p); + if (scm_is_false (var)) + var = scm_c_private_lookup ("guile", "call-with-output-string"); - return scm_get_output_string (p); + return scm_call_1 (scm_variable_ref (var), proc); } -#undef FUNC_NAME -SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0, - (SCM string, SCM proc), - "Calls the one-argument procedure @var{proc} with a newly\n" - "created input port from which @var{string}'s contents may be\n" - "read. The value yielded by the @var{proc} is returned.") -#define FUNC_NAME s_scm_call_with_input_string +SCM +scm_call_with_input_string (SCM string, SCM proc) { - SCM p = scm_mkstrport(SCM_INUM0, string, SCM_OPN | SCM_RDNG, FUNC_NAME); - return scm_call_1 (proc, p); + static SCM var = SCM_BOOL_F; + + if (scm_is_false (var)) + var = scm_c_private_lookup ("guile", "call-with-input-string"); + + return scm_call_2 (scm_variable_ref (var), string, proc); } -#undef FUNC_NAME SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0, (SCM str), @@ -508,6 +454,16 @@ scm_c_eval_string_in_module (const char *expr, SCM module) } +static SCM eval_string_var; +static SCM k_module; + +static void +init_eval_string_var_and_k_module (void) +{ + eval_string_var = scm_c_public_variable ("ice-9 eval-string", "eval-string"); + k_module = scm_from_locale_keyword ("module"); +} + SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, (SCM string, SCM module), "Evaluate @var{string} as the text representation of a Scheme\n" @@ -519,20 +475,16 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, "procedure returns.") #define FUNC_NAME s_scm_eval_string_in_module { - static SCM eval_string = SCM_BOOL_F, k_module = SCM_BOOL_F; - - if (scm_is_false (eval_string)) - { - eval_string = scm_c_public_lookup ("ice-9 eval-string", "eval-string"); - k_module = scm_from_locale_keyword ("module"); - } + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_eval_string_var_and_k_module); if (SCM_UNBNDP (module)) module = scm_current_module (); else SCM_VALIDATE_MODULE (2, module); - return scm_call_3 (scm_variable_ref (eval_string), string, k_module, module); + return scm_call_3 (scm_variable_ref (eval_string_var), + string, k_module, module); } #undef FUNC_NAME @@ -545,10 +497,9 @@ scm_eval_string (SCM string) static scm_t_bits scm_make_stptob () { - scm_t_bits tc = scm_make_port_type ("string", stfill_buffer, st_write); + scm_t_bits tc = scm_make_port_type ("string", st_fill_input, st_write); scm_set_port_end_input (tc, st_end_input); - scm_set_port_flush (tc, st_flush); scm_set_port_seek (tc, st_seek); scm_set_port_truncate (tc, st_truncate);