defsubst

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

diff --git a/libguile/ports.c b/libguile/ports.c
index e256d65..98d2fa2 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ *   2014, 2015 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
@@ -70,9 +71,7 @@
 #include <io.h>
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #ifdef HAVE_SYS_IOCTL_H
 #include <sys/ioctl.h>
@@ -262,7 +261,7 @@ scm_make_port_type (char *name,
   ptobnum = scm_c_port_type_add_x (desc);
 
   /* Make a class object if GOOPS is present.  */
-  if (SCM_UNPACK (scm_port_class[0]) != 0)
+  if (SCM_UNPACK (scm_i_port_class[0]) != 0)
     scm_make_port_classes (ptobnum, name);
 
   return scm_tc7_port + ptobnum * 256;
@@ -391,10 +390,11 @@ SCM_DEFINE (scm_i_set_port_property_x, "%set-port-property!", 3, 0, 0,
 static SCM cur_inport_fluid = SCM_BOOL_F;
 static SCM cur_outport_fluid = SCM_BOOL_F;
 static SCM cur_errport_fluid = SCM_BOOL_F;
+static SCM cur_warnport_fluid = SCM_BOOL_F;
 static SCM cur_loadport_fluid = SCM_BOOL_F;
 
 SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
-           (),
+           (void),
            "Return the current input port.  This is the default port used\n"
            "by many input procedures.  Initially, @code{current-input-port}\n"
            "returns the @dfn{standard input} in Unix and C terminology.")
@@ -408,7 +408,7 @@ SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
-           (),
+           (void),
             "Return the current output port.  This is the default port used\n"
            "by many output procedures.  Initially,\n"
            "@code{current-output-port} returns the @dfn{standard output} in\n"
@@ -423,7 +423,7 @@ SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
-           (),
+            (void),
            "Return the port to which errors and warnings should be sent (the\n"
            "@dfn{standard error} in Unix and C terminology).")
 #define FUNC_NAME s_scm_current_error_port
@@ -435,23 +435,17 @@ 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)
+SCM_DEFINE (scm_current_warning_port, "current-warning-port", 0, 0, 0,
+            (void),
+           "Return the port to which diagnostic warnings should be sent.")
+#define FUNC_NAME s_scm_current_warning_port
 {
-  scm_i_pthread_once (&current_warning_port_once,
-                      init_current_warning_port_var);
-  return scm_call_0 (scm_variable_ref (current_warning_port_var));
+  if (scm_is_true (cur_warnport_fluid))
+    return scm_fluid_ref (cur_warnport_fluid);
+  else
+    return SCM_BOOL_F;
 }
+#undef FUNC_NAME
 
 SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
            (),
@@ -510,11 +504,15 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
 
 SCM
 scm_set_current_warning_port (SCM port)
+#define FUNC_NAME "set-current-warning-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);
+  SCM owarnp = scm_fluid_ref (cur_warnport_fluid);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPOUTPORT (1, port);
+  scm_fluid_set_x (cur_warnport_fluid, port);
+  return owarnp;
 }
+#undef FUNC_NAME
 
 
 void
@@ -2141,7 +2139,7 @@ scm_ungetc_unlocked (scm_t_wchar c, SCM port)
 
   if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
     {
-      if (c < 0xf0)
+      if (c < 0x80)
         {
           result_buf[0] = (char) c;
           result = result_buf;
@@ -2174,14 +2172,8 @@ scm_ungetc_unlocked (scm_t_wchar c, SCM port)
     free (result);
 
   if (c == '\n')
-    {
-      /* What should col be in this case?
-       * We'll leave it at -1.
-       */
-      SCM_LINUM (port) -= 1;
-    }
-  else
-    SCM_COL(port) -= 1;
+    SCM_LINUM (port) -= 1;
+  SCM_DECCOL (port);
 }
 #undef FUNC_NAME
 
@@ -3197,6 +3189,7 @@ scm_init_ports ()
   cur_inport_fluid = scm_make_fluid ();
   cur_outport_fluid = scm_make_fluid ();
   cur_errport_fluid = scm_make_fluid ();
+  cur_warnport_fluid = scm_make_fluid ();
   cur_loadport_fluid = scm_make_fluid ();
 
   scm_i_port_weak_set = scm_c_make_weak_set (31);
@@ -3217,6 +3210,7 @@ scm_init_ports ()
   scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
   scm_c_define ("%current-output-port-fluid", cur_outport_fluid);
   scm_c_define ("%current-error-port-fluid", cur_errport_fluid);
+  scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid);
 }
 
 /*