-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006,
+ * 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
* as published by the Free Software Foundation; either version 3 of
#include "libguile/_scm.h"
#include <stdio.h>
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif
#include "libguile/bytevectors.h"
#include "libguile/eval.h"
{
SCM z, buf;
scm_t_port *pt;
- const char *encoding;
- size_t read_buf_size, 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);
- encoding = scm_i_default_port_encoding ();
-
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 the port. */
read_buf_size = 0;
- c_pos = 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 ENCODING. */
- copy = scm_to_stringn (str, &str_len, 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);
- 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));
}
z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
- encoding,
- SCM_FAILED_CONVERSION_ERROR,
- (scm_t_bits)buf);
+ "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->read_pos = pt->write_pos = pt->read_buf + c_byte_pos;
pt->read_buf_size = read_buf_size;
- pt->write_buf_size = str_len;
+ pt->write_buf_size = num_bytes;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
pt->rw_random = 1;
if (pt->read_buf_size == 0)
return scm_nullstr;
- return scm_from_stringn ((char *)pt->read_buf, pt->read_buf_size,
- pt->encoding, pt->ilseq_handler);
+ 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,
}
+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"
"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