build: Don't include <config.h> in native programs when cross-compiling.

[bpt/guile.git] / libguile / strports.c

diff --git a/libguile/strports.c b/libguile/strports.c
index 957c6a1..f306019 100644 (file)
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006,
+ *   2009, 2010, 2011, 2012, 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
@@ -26,9 +27,7 @@
 #include "libguile/_scm.h"
 
 #include <stdio.h>
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #include "libguile/bytevectors.h"
 #include "libguile/eval.h"
@@ -287,7 +286,18 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   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);
+  SCM_SET_CELL_TYPE (z, scm_tc16_strport);
+  pt = SCM_PTAB_ENTRY (z);
+
+  /* Make PT initially empty, and release the port-table mutex
+     immediately.  This is so that if one of the function calls below
+     raises an exception, a pre-unwind catch handler can still create
+     new ports; for instance, `display-backtrace' needs to be able to
+     allocate a new string port.  See <http://bugs.gnu.org/11197>.  */
+  scm_port_non_buffer (pt);
+  SCM_SETSTREAM (z, SCM_UNPACK (scm_null_bytevector));
+
+  scm_dynwind_end ();
 
   if (scm_is_false (str))
     {
@@ -295,10 +305,6 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       str_len = INITIAL_BUFFER_SIZE;
       buf = scm_c_make_bytevector (str_len);
       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;
     }
   else
@@ -317,12 +323,21 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       free (copy);
 
       c_pos = scm_to_unsigned_integer (pos, 0, str_len);
-      pt->read_buf_size = str_len;
     }
 
+  /* Now, finish up the port.  */
+  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+
   SCM_SETSTREAM (z, SCM_UNPACK (buf));
   SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
 
+  if (scm_is_false (str))
+    /* Reset `read_buf_size'.  It will contain the actual number of
+       bytes written to PT.  */
+    pt->read_buf_size = 0;
+  else
+    pt->read_buf_size = str_len;
+
   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;
@@ -330,13 +345,12 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
 
   pt->rw_random = 1;
 
-  scm_dynwind_end ();
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 
   /* Ensure WRITE_POS is writable.  */
   if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
     st_flush (z);
 
-  scm_i_set_conversion_strategy_x (z, SCM_FAILED_CONVERSION_ERROR);
   return z;
 }
 
@@ -357,7 +371,7 @@ scm_strport_to_string (SCM port)
   if (pt->encoding == NULL)
     {
       char *buf;
-      str = scm_i_make_string (pt->read_buf_size, &buf);
+      str = scm_i_make_string (pt->read_buf_size, &buf, 0);
       memcpy (buf, pt->read_buf, pt->read_buf_size);
     }
   else
@@ -507,23 +521,14 @@ scm_c_eval_string_in_module (const char *expr, SCM module)
 }
 
 
-static SCM
-inner_eval_string (void *data)
-{
-  SCM port = (SCM)data;
-  SCM form;
-  SCM ans = SCM_UNSPECIFIED;
-
-  /* Read expressions from that port; ignore the values.  */
-  while (!SCM_EOF_OBJECT_P (form = scm_read (port)))
-    ans = scm_primitive_eval_x (form);
-
-  /* Don't close the port here; if we re-enter this function via a
-     continuation, then the next time we enter it, we'll get an error.
-     It's a string port anyway, so there's no advantage to closing it
-     early.  */
+static SCM eval_string_var;
+static SCM k_module;
 
-  return ans;
+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, 
@@ -537,14 +542,16 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0,
             "procedure returns.")
 #define FUNC_NAME s_scm_eval_string_in_module
 {
-  SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG,
-                           FUNC_NAME);
+  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_c_call_with_current_module (module,
-                                        inner_eval_string, (void *)port);
+
+  return scm_call_3 (scm_variable_ref (eval_string_var),
+                     string, k_module, module);
 }
 #undef FUNC_NAME