Merge commit 'ca5e0414e96886177d883a249edd957d2331db65'

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

diff --git a/libguile/ports.c b/libguile/ports.c
index 44416cb..e256d65 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- *   2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
+ *   2007, 2008, 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
@@ -60,6 +60,7 @@
 #include "libguile/weak-set.h"
 #include "libguile/fluids.h"
 #include "libguile/eq.h"
+#include "libguile/alist.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -330,6 +331,12 @@ scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM))
   scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
 }
 
+void
+scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM, long, long))
+{
+  scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
+}
+
 static void
 scm_i_set_pending_eof (SCM port)
 {
@@ -342,17 +349,40 @@ scm_i_clear_pending_eof (SCM port)
   SCM_PORT_GET_INTERNAL (port)->pending_eof = 0;
 }
 
-SCM
-scm_i_port_alist (SCM port)
+SCM_DEFINE (scm_i_port_property, "%port-property", 2, 0, 0,
+            (SCM port, SCM key),
+            "Return the property of @var{port} associated with @var{key}.")
+#define FUNC_NAME s_scm_i_port_property
 {
-  return SCM_PORT_GET_INTERNAL (port)->alist;
+  scm_i_pthread_mutex_t *lock;
+  SCM result;
+
+  SCM_VALIDATE_OPPORT (1, port);
+  scm_c_lock_port (port, &lock);
+  result = scm_assq_ref (SCM_PORT_GET_INTERNAL (port)->alist, key);
+  if (lock)
+    scm_i_pthread_mutex_unlock (lock);
+  return result;
 }
+#undef FUNC_NAME
 
-void
-scm_i_set_port_alist_x (SCM port, SCM alist)
+SCM_DEFINE (scm_i_set_port_property_x, "%set-port-property!", 3, 0, 0,
+            (SCM port, SCM key, SCM value),
+            "Set the property of @var{port} associated with @var{key} to @var{value}.")
+#define FUNC_NAME s_scm_i_set_port_property_x
 {
-  SCM_PORT_GET_INTERNAL (port)->alist = alist;
+  scm_i_pthread_mutex_t *lock;
+  scm_t_port_internal *pti;
+
+  SCM_VALIDATE_OPPORT (1, port);
+  scm_c_lock_port (port, &lock);
+  pti = SCM_PORT_GET_INTERNAL (port);
+  pti->alist = scm_assq_set_x (pti->alist, key, value);
+  if (lock)
+    scm_i_pthread_mutex_unlock (lock);
+  return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
 
 \f
 
@@ -405,19 +435,22 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM current_warning_port_var;
+static scm_i_pthread_once_t current_warning_port_once = SCM_I_PTHREAD_ONCE_INIT;
+
+static void
+init_current_warning_port_var (void)
+{
+  current_warning_port_var
+    = scm_c_private_variable ("guile", "current-warning-port");
+}
+
 SCM
 scm_current_warning_port (void)
 {
-  static SCM cwp_var = SCM_UNDEFINED;
-  static scm_i_pthread_mutex_t cwp_var_mutex
-    = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-  scm_i_scm_pthread_mutex_lock (&cwp_var_mutex);
-  if (SCM_UNBNDP (cwp_var))
-    cwp_var = scm_c_private_variable ("guile", "current-warning-port");
-  scm_i_pthread_mutex_unlock (&cwp_var_mutex);
-  
-  return scm_call_0 (scm_variable_ref (cwp_var));
+  scm_i_pthread_once (&current_warning_port_once,
+                      init_current_warning_port_var);
+  return scm_call_0 (scm_variable_ref (current_warning_port_var));
 }
 
 SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
@@ -478,12 +511,9 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
 SCM
 scm_set_current_warning_port (SCM port)
 {
-  static SCM cwp_var = SCM_BOOL_F;
-
-  if (scm_is_false (cwp_var))
-    cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
-  
-  return scm_call_1 (scm_variable_ref (cwp_var), port);
+  scm_i_pthread_once (&current_warning_port_once,
+                      init_current_warning_port_var);
+  return scm_call_1 (scm_variable_ref (current_warning_port_var), port);
 }
 
 
@@ -598,7 +628,6 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-
 \f
 
 /* The port table --- a weak set of all ports.
@@ -1274,8 +1303,6 @@ SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
 {
   scm_t_string_failed_conversion_handler h;
 
-  SCM_VALIDATE_OPPORT (1, port);
-
   if (scm_is_false (port))
     h = scm_i_default_port_conversion_handler ();
   else
@@ -2221,7 +2248,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
   scm_t_wchar c;
   char bytes[SCM_MBCHAR_BUF_SIZE];
   long column, line;
-  size_t len;
+  size_t len = 0;
 
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();