Include "libguile/async.h" for SCM_CRITICAL_SECTION_START/END.
[bpt/guile.git] / libguile / ports.c
index 6e14466..94182bf 100644 (file)
 #include <errno.h>
 
 #include "libguile/_scm.h"
+#include "libguile/async.h"
 #include "libguile/eval.h"
 #include "libguile/objects.h"
+#include "libguile/goops.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"
 #include "libguile/dynwind.h"
@@ -39,6 +41,8 @@
 #include "libguile/mallocs.h"
 #include "libguile/validate.h"
 #include "libguile/ports.h"
+#include "libguile/vectors.h"
+#include "libguile/fluids.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -119,7 +123,7 @@ scm_make_port_type (char *name,
   char *tmp;
   if (255 <= scm_numptob)
     goto ptoberr;
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs,
                                       (1 + scm_numptob)
                                       * sizeof (scm_t_ptob_descriptor)));
@@ -146,7 +150,7 @@ scm_make_port_type (char *name,
 
       scm_numptob++;
     }
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (!tmp)
     {
     ptoberr:
@@ -244,7 +248,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
   scm_t_port *pt;
 
   if (SCM_UNBNDP (port))
-    port = scm_cur_inp;
+    port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (1, port);
 
@@ -262,7 +266,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
       scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
       
       if (ptob->input_waiting)
-       return SCM_BOOL(ptob->input_waiting (port));
+       return scm_from_bool(ptob->input_waiting (port));
       else
        return SCM_BOOL_T;
     }
@@ -319,6 +323,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 #define FUNC_NAME s_scm_drain_input
 {
   SCM result;
+  char *data;
   scm_t_port *pt;
   long count;
 
@@ -329,9 +334,8 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
   if (pt->read_buf == pt->putback_buf)
     count += pt->saved_read_end - pt->saved_read_pos;
 
-  result = scm_allocate_string (count);
-  scm_take_from_input_buffers (port, SCM_STRING_CHARS (result), count);
-
+  result = scm_i_make_string (count, &data);
+  scm_take_from_input_buffers (port, data, count);
   return result;
 }
 #undef FUNC_NAME
@@ -339,6 +343,11 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 \f
 /* Standard ports --- current input, output, error, and more(!).  */
 
+static SCM cur_inport_fluid;
+static SCM cur_outport_fluid;
+static SCM cur_errport_fluid;
+static SCM cur_loadport_fluid;
+
 SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
            (),
            "Return the current input port.  This is the default port used\n"
@@ -346,7 +355,7 @@ SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
            "returns the @dfn{standard input} in Unix and C terminology.")
 #define FUNC_NAME s_scm_current_input_port
 {
-  return scm_cur_inp;
+  return scm_fluid_ref (cur_inport_fluid);
 }
 #undef FUNC_NAME
 
@@ -358,7 +367,7 @@ SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
            "Unix and C terminology.")
 #define FUNC_NAME s_scm_current_output_port
 {
-  return scm_cur_outp;
+  return scm_fluid_ref (cur_outport_fluid);
 }
 #undef FUNC_NAME
 
@@ -368,7 +377,7 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
            "@dfn{standard error} in Unix and C terminology).")
 #define FUNC_NAME s_scm_current_error_port
 {
-  return scm_cur_errp;
+  return scm_fluid_ref (cur_errport_fluid);
 }
 #undef FUNC_NAME
 
@@ -378,7 +387,7 @@ SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
             "The load port is used internally by @code{primitive-load}.")
 #define FUNC_NAME s_scm_current_load_port
 {
-  return scm_cur_loadp;
+  return scm_fluid_ref (cur_loadport_fluid);
 }
 #undef FUNC_NAME
 
@@ -391,9 +400,9 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
            "so that they use the supplied @var{port} for input or output.")
 #define FUNC_NAME s_scm_set_current_input_port
 {
-  SCM oinp = scm_cur_inp;
+  SCM oinp = scm_fluid_ref (cur_inport_fluid);
   SCM_VALIDATE_OPINPORT (1, port);
-  scm_cur_inp = port;
+  scm_fluid_set_x (cur_inport_fluid, port);
   return oinp;
 }
 #undef FUNC_NAME
@@ -404,10 +413,10 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
            "Set the current default output port to @var{port}.")
 #define FUNC_NAME s_scm_set_current_output_port
 {
-  SCM ooutp = scm_cur_outp;
+  SCM ooutp = scm_fluid_ref (cur_outport_fluid);
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPOUTPORT (1, port);
-  scm_cur_outp = port;
+  scm_fluid_set_x (cur_outport_fluid, port);
   return ooutp;
 }
 #undef FUNC_NAME
@@ -418,69 +427,47 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
            "Set the current default error port to @var{port}.")
 #define FUNC_NAME s_scm_set_current_error_port
 {
-  SCM oerrp = scm_cur_errp;
+  SCM oerrp = scm_fluid_ref (cur_errport_fluid);
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPOUTPORT (1, port);
-  scm_cur_errp = port;
+  scm_fluid_set_x (cur_errport_fluid, port);
   return oerrp;
 }
 #undef FUNC_NAME
 
-typedef struct {
-  SCM value;
-  SCM (*getter) (void);
-  SCM (*setter) (SCM);
-} swap_data;
-
-static void
-swap_port (SCM scm_data)
-{
-  swap_data *d = (swap_data *)SCM_MALLOCDATA (scm_data);
-  SCM t;
-
-  t = d->getter ();
-  d->setter (d->value);
-  d->value = t;
-}
-
-static void
-scm_frame_current_foo_port (SCM port,
-                          SCM (*getter) (void), SCM (*setter) (SCM))
-{
-  SCM scm_data = scm_malloc_obj (sizeof (swap_data));
-  swap_data *data = (swap_data *)SCM_MALLOCDATA (scm_data);
-  data->value = port;
-  data->getter = getter;
-  data->setter = setter;
-  
-  scm_frame_rewind_handler_with_scm (swap_port, scm_data,
-                                    SCM_F_WIND_EXPLICITLY);
-  scm_frame_unwind_handler_with_scm (swap_port, scm_data,
-                                    SCM_F_WIND_EXPLICITLY);
-}
-
 void
 scm_frame_current_input_port (SCM port)
+#define FUNC_NAME NULL
 {
-  scm_frame_current_foo_port (port,
-                             scm_current_input_port,
-                             scm_set_current_input_port);
+  SCM_VALIDATE_OPINPORT (1, port);
+  scm_frame_fluid (cur_inport_fluid, port);
 }
+#undef FUNC_NAME
 
 void
 scm_frame_current_output_port (SCM port)
+#define FUNC_NAME NULL
 {
-  scm_frame_current_foo_port (port,
-                             scm_current_output_port,
-                             scm_set_current_output_port);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPOUTPORT (1, port);
+  scm_frame_fluid (cur_outport_fluid, port);
 }
+#undef FUNC_NAME
 
 void
 scm_frame_current_error_port (SCM port)
+#define FUNC_NAME NULL
+{
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPOUTPORT (1, port);
+  scm_frame_fluid (cur_errport_fluid, port);
+}
+#undef FUNC_NAME
+
+void
+scm_i_frame_current_load_port (SCM port)
 {
-  scm_frame_current_foo_port (port,
-                             scm_current_error_port,
-                             scm_set_current_error_port);
+  scm_frame_fluid (cur_loadport_fluid, port);
 }
 
 \f
@@ -491,7 +478,7 @@ scm_t_port **scm_i_port_table;
 long scm_i_port_table_size = 0;        /* Number of ports in scm_i_port_table.  */
 long scm_i_port_table_room = 20;       /* Size of the array.  */
 
-SCM_GLOBAL_MUTEX (scm_i_port_table_mutex);
+scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 /* This function is not and should not be thread safe. */
 
@@ -587,7 +574,7 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
            "is only included in @code{--enable-guile-debug} builds.")
 #define FUNC_NAME s_scm_pt_size
 {
-  return SCM_MAKINUM (scm_i_port_table_size);
+  return scm_from_int (scm_i_port_table_size);
 }
 #undef FUNC_NAME
 
@@ -598,9 +585,8 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
            "@code{--enable-guile-debug} builds.")
 #define FUNC_NAME s_scm_pt_member
 {
-  long i;
-  SCM_VALIDATE_INUM_COPY (1, index, i);
-  if (i < 0 || i >= scm_i_port_table_size)
+  size_t i = scm_to_size_t (index);
+  if (i >= scm_i_port_table_size)
     return SCM_BOOL_F;
   else
     return scm_i_port_table[i]->port;
@@ -641,7 +627,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  return SCM_MAKINUM (scm_revealed_count (port));
+  return scm_from_int (scm_revealed_count (port));
 }
 #undef FUNC_NAME
 
@@ -654,8 +640,7 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  SCM_VALIDATE_INUM (2, rcount);
-  SCM_REVEALED (port) = SCM_INUM (rcount);
+  SCM_REVEALED (port) = scm_to_int (rcount);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -670,18 +655,37 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
  * See PORT FLAGS in scm.h
  */
 
+static long
+scm_i_mode_bits_n (const char *modes, size_t n)
+{
+  return (SCM_OPN
+         | (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
+         | (   memchr (modes, 'w', n)
+            || memchr (modes, 'a', n)
+            || memchr (modes, '+', n) ? SCM_WRTNG : 0)
+         | (memchr (modes, '0', n) ? SCM_BUF0 : 0)
+         | (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
+}
+
 long
 scm_mode_bits (char *modes)
 {
-  return (SCM_OPN
-         | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
-         | (   strchr (modes, 'w')
-            || strchr (modes, 'a')
-            || strchr (modes, '+') ? SCM_WRTNG : 0)
-         | (strchr (modes, '0') ? SCM_BUF0 : 0)
-         | (strchr (modes, 'l') ? SCM_BUFLINE : 0));
+  return scm_i_mode_bits_n (modes, strlen (modes));
 }
 
+long
+scm_i_mode_bits (SCM modes)
+{
+  long bits;
+
+  if (!scm_is_string (modes))
+    scm_wrong_type_arg_msg (NULL, 0, modes, "string");
+
+  bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
+                           scm_i_string_length (modes));
+  scm_remember_upto_here_1 (modes);
+  return bits;
+}
 
 /* Return the mode flags from an open port.
  * Some modes such as "append" are only used when opening
@@ -710,7 +714,7 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
     strcpy (modes, "w");
   if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
     strcat (modes, "0");
-  return scm_mem2string (modes, strlen (modes));
+  return scm_from_locale_string (modes);
 }
 #undef FUNC_NAME
 
@@ -745,11 +749,11 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
     rv = (scm_ptobs[i].close) (port);
   else
     rv = 0;
-  scm_mutex_lock (&scm_i_port_table_mutex);
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
   scm_remove_from_port_table (port);
-  scm_mutex_unlock (&scm_i_port_table_mutex);
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
   SCM_CLR_PORT_OPEN_FLAG (port);
-  return SCM_BOOL (rv >= 0);
+  return scm_from_bool (rv >= 0);
 }
 #undef FUNC_NAME
 
@@ -788,26 +792,29 @@ void
 scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
 {
   long i;
+  size_t n;
   SCM ports;
 
   /* Even without pre-emptive multithreading, running arbitrary code
      while scanning the port table is unsafe because the port table
-     can change arbitrarily (from a GC, for example).  So we build a
-     list in advance while blocking the GC. -mvo */
+     can change arbitrarily (from a GC, for example).  So we first
+     collect the ports into a vector. -mvo */
 
-  scm_mutex_lock (&scm_i_port_table_mutex);
-  scm_block_gc++;
-  ports = SCM_EOL;
-  for (i = 0; i < scm_i_port_table_size; i++)
-    ports = scm_cons (scm_i_port_table[i]->port, ports);
-  scm_block_gc--;
-  scm_mutex_unlock (&scm_i_port_table_mutex);
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  n = scm_i_port_table_size;
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 
-  while (ports != SCM_EOL)
-    {
-      proc (data, SCM_CAR (ports));
-      ports = SCM_CDR (ports);
-    }
+  ports = scm_c_make_vector (n, SCM_BOOL_F);
+
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  if (n > scm_i_port_table_size)
+    n = scm_i_port_table_size;
+  for (i = 0; i < n; i++)
+    SCM_SIMPLE_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+
+  for (i = 0; i < n; i++)
+    proc (data, SCM_SIMPLE_VECTOR_REF (ports, i));
 }
 
 SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
@@ -838,7 +845,7 @@ SCM_DEFINE (scm_input_port_p, "input-port?", 1, 0, 0,
            "@code{port?}.")
 #define FUNC_NAME s_scm_input_port_p
 {
-  return SCM_BOOL (SCM_INPUT_PORT_P (x));
+  return scm_from_bool (SCM_INPUT_PORT_P (x));
 }
 #undef FUNC_NAME
 
@@ -850,7 +857,7 @@ SCM_DEFINE (scm_output_port_p, "output-port?", 1, 0, 0,
 #define FUNC_NAME s_scm_output_port_p
 {
   x = SCM_COERCE_OUTPORT (x);
-  return SCM_BOOL (SCM_OUTPUT_PORT_P (x));
+  return scm_from_bool (SCM_OUTPUT_PORT_P (x));
 }
 #undef FUNC_NAME
 
@@ -861,7 +868,7 @@ SCM_DEFINE (scm_port_p, "port?", 1, 0, 0,
            "@var{x}))}.")
 #define FUNC_NAME s_scm_port_p
 {
-  return SCM_BOOL (SCM_PORTP (x));
+  return scm_from_bool (SCM_PORTP (x));
 }
 #undef FUNC_NAME
 
@@ -872,7 +879,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0,
 #define FUNC_NAME s_scm_port_closed_p
 {
   SCM_VALIDATE_PORT (1, port);
-  return SCM_BOOL (!SCM_OPPORTP (port));
+  return scm_from_bool (!SCM_OPPORTP (port));
 }
 #undef FUNC_NAME
 
@@ -882,7 +889,7 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0,
            "return @code{#f}.")
 #define FUNC_NAME s_scm_eof_object_p
 {
-  return SCM_BOOL(SCM_EOF_OBJECT_P (x));
+  return scm_from_bool(SCM_EOF_OBJECT_P (x));
 }
 #undef FUNC_NAME
 
@@ -897,7 +904,7 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
 #define FUNC_NAME s_scm_force_output
 {
   if (SCM_UNBNDP (port))
-    port = scm_cur_outp;
+    port = scm_current_output_port ();
   else
     {
       port = SCM_COERCE_OUTPORT (port);
@@ -916,13 +923,13 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
 {
   size_t i;
 
-  scm_mutex_lock (&scm_i_port_table_mutex);
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
   for (i = 0; i < scm_i_port_table_size; i++)
     {
       if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
        scm_flush (scm_i_port_table[i]->port);
     }
-  scm_mutex_unlock (&scm_i_port_table_mutex);
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -936,7 +943,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 {
   int c;
   if (SCM_UNBNDP (port))
-    port = scm_cur_inp;
+    port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
   c = scm_getc (port);
   if (EOF == c)
@@ -989,9 +996,17 @@ scm_getc (SCM port)
 
   switch (c)
     {
+      case '\a':
+        break;
+      case '\b':
+        SCM_DECCOL (port);
+        break;
       case '\n':
         SCM_INCLINE (port);
         break;
+      case '\r':
+        SCM_ZEROCOL (port);
+        break;
       case '\t':
         SCM_TABCOL (port);
         break;
@@ -1032,9 +1047,17 @@ scm_lfwrite (const char *ptr, size_t size, SCM port)
   ptob->write (port, ptr, size);
 
   for (; size; ptr++, size--) {
-    if (*ptr == '\n') {
+    if (*ptr == '\a') {
+    }
+    else if (*ptr == '\b') {
+      SCM_DECCOL(port);
+    }
+    else if (*ptr == '\n') {
       SCM_INCLINE(port);
     }
+    else if (*ptr == '\r') {
+      SCM_ZEROCOL(port);
+    }
     else if (*ptr == '\t') {
       SCM_TABCOL(port);
     }
@@ -1262,7 +1285,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
 {
   int c, column;
   if (SCM_UNBNDP (port))
-    port = scm_cur_inp;
+    port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (1, port);
   column = SCM_COL(port);
@@ -1287,7 +1310,7 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
 
   SCM_VALIDATE_CHAR (1, cobj);
   if (SCM_UNBNDP (port))
-    port = scm_cur_inp;
+    port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (2, port);
 
@@ -1308,11 +1331,11 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
 {
   SCM_VALIDATE_STRING (1, str);
   if (SCM_UNBNDP (port))
-    port = scm_cur_inp;
+    port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (2, port);
 
-  scm_ungets (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port);
+  scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
   
   return str;
 }
@@ -1351,8 +1374,12 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
 
   fd_port = SCM_COERCE_OUTPORT (fd_port);
 
-  off = SCM_NUM2LONG (2, offset);
-  SCM_VALIDATE_INUM_COPY (3, whence, how);
+  if (sizeof (off_t) == sizeof (scm_t_intmax))
+    off = scm_to_intmax (offset);
+  else
+    off = scm_to_long (offset);
+  how = scm_to_int (whence);
+
   if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
     SCM_OUT_OF_RANGE (3, whence);
   if (SCM_OPPORTP (fd_port))
@@ -1367,12 +1394,11 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
     }
   else /* file descriptor?.  */
     {
-      SCM_VALIDATE_INUM (1, fd_port);
-      rv = lseek (SCM_INUM (fd_port), off, how);
+      rv = lseek (scm_to_int (fd_port), off, how);
       if (rv == -1)
        SCM_SYSERROR;
     }
-  return scm_long2num (rv);
+  return scm_from_intmax (rv);
 }
 #undef FUNC_NAME
 
@@ -1396,7 +1422,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
            "@var{length} bytes.  @var{object} can be a string containing a\n"
            "file name or an integer file descriptor or a port.\n"
            "@var{length} may be omitted if @var{object} is not a file name,\n"
-           "in which case the truncation occurs at the current port.\n"
+           "in which case the truncation occurs at the current port\n"
            "position.  The return value is unspecified.")
 #define FUNC_NAME s_scm_truncate_file
 {
@@ -1408,19 +1434,17 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
   if (SCM_UNBNDP (length))
     {
       /* must supply length if object is a filename.  */
-      if (SCM_STRINGP (object))
+      if (scm_is_string (object))
         SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL);
       
-      length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
+      length = scm_seek (object, SCM_INUM0, scm_from_int (SEEK_CUR));
     }
-  c_length = SCM_NUM2LONG (2, length);
-  if (c_length < 0)
-    SCM_MISC_ERROR ("negative offset", SCM_EOL);
+  c_length = scm_to_size_t (length);
 
   object = SCM_COERCE_OUTPORT (object);
-  if (SCM_INUMP (object))
+  if (scm_is_integer (object))
     {
-      SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length));
+      SCM_SYSCALL (rv = ftruncate (scm_to_int (object), c_length));
     }
   else if (SCM_OPOUTPORTP (object))
     {
@@ -1439,8 +1463,12 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
     }
   else
     {
-      SCM_VALIDATE_STRING (1, object);
-      SCM_SYSCALL (rv = truncate (SCM_STRING_CHARS (object), c_length));
+      char *str = scm_to_locale_string (object);
+      int eno;
+      SCM_SYSCALL (rv = truncate (str, c_length));
+      eno = errno;
+      free (str);
+      errno = eno;
     }
   if (rv == -1)
     SCM_SYSERROR;
@@ -1450,33 +1478,37 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
 
 SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0,
             (SCM port),
-           "Return the current line number for @var{port}.")
+           "Return the current line number for @var{port}.\n"
+           "\n"
+           "The first line of a file is 0.  But you might want to add 1\n"
+           "when printing line numbers, since starting from 1 is\n"
+           "traditional in error messages, and likely to be more natural to\n"
+           "non-programmers.")
 #define FUNC_NAME s_scm_port_line
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  return SCM_MAKINUM (SCM_LINUM (port));
+  return scm_from_int (SCM_LINUM (port));
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0,
             (SCM port, SCM line),
-           "Set the current line number for @var{port} to @var{line}.")
+           "Set the current line number for @var{port} to @var{line}.  The\n"
+           "first line of a file is 0.")
 #define FUNC_NAME s_scm_set_port_line_x
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  SCM_VALIDATE_INUM (2, line);
-  SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
+  SCM_PTAB_ENTRY (port)->line_number = scm_to_int (line);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0,
             (SCM port),
-           "@deffnx {Scheme Procedure} port-line port\n"
-           "Return the current column number or line number of @var{port},\n"
-           "using the current input port if none is specified.  If the number is\n"
+           "Return the current column number of @var{port}.\n"
+           "If the number is\n"
            "unknown, the result is #f.  Otherwise, the result is a 0-origin integer\n"
            "- i.e. the first character of the first line is line 0, column 0.\n"
            "(However, when you display a file position, for example in an error\n"
@@ -1487,21 +1519,19 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0,
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  return SCM_MAKINUM (SCM_COL (port));
+  return scm_from_int (SCM_COL (port));
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0,
             (SCM port, SCM column),
-           "@deffnx {Scheme Procedure} set-port-line! port line\n"
-           "Set the current column or line number of @var{port}, using the\n"
-           "current input port if none is specified.")
+           "Set the current column of @var{port}.  Before reading the first\n"
+           "character on a line the column should be 0.")
 #define FUNC_NAME s_scm_set_port_column_x
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPENPORT (1, port);
-  SCM_VALIDATE_INUM (2, column);
-  SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
+  SCM_PTAB_ENTRY (port)->column_number = scm_to_int (column);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1535,10 +1565,6 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-#ifndef ttyname
-extern char * ttyname();
-#endif
-
 void
 scm_print_port_mode (SCM exp, SCM port)
 {
@@ -1564,7 +1590,7 @@ scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
   scm_print_port_mode (exp, port);
   scm_puts (type, port);
   scm_putc (' ', port);
-  scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
+  scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
   scm_putc ('>', port);
   return 1;
 }
@@ -1594,12 +1620,11 @@ write_void_port (SCM port SCM_UNUSED,
 {
 }
 
-SCM
-scm_void_port (char *mode_str)
+static SCM
+scm_i_void_port (long mode_bits)
 {
-  scm_mutex_lock (&scm_i_port_table_mutex);
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
   {
-    int mode_bits = scm_mode_bits (mode_str);
     SCM answer = scm_new_port_table_entry (scm_tc16_void_port);
     scm_t_port * pt = SCM_PTAB_ENTRY(answer);
 
@@ -1607,11 +1632,17 @@ scm_void_port (char *mode_str)
   
     SCM_SETSTREAM (answer, 0);
     SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
-    scm_mutex_unlock (&scm_i_port_table_mutex);
+    scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
     return answer;
   }
 }
 
+SCM
+scm_void_port (char *mode_str)
+{
+  return scm_i_void_port (scm_mode_bits (mode_str));
+}
+
 SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
             (SCM mode),
            "Create and return a new void port.  A void port acts like\n"
@@ -1620,8 +1651,7 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
            "documentation for @code{open-file} in @ref{File Ports}.")
 #define FUNC_NAME s_scm_sys_make_void_port
 {
-  SCM_VALIDATE_STRING (1, mode);
-  return scm_void_port (SCM_STRING_CHARS (mode));
+  return scm_i_void_port (scm_i_mode_bits (mode));
 }
 #undef FUNC_NAME
 
@@ -1632,12 +1662,18 @@ void
 scm_init_ports ()
 {
   /* lseek() symbols.  */
-  scm_c_define ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
-  scm_c_define ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
-  scm_c_define ("SEEK_END", SCM_MAKINUM (SEEK_END));
+  scm_c_define ("SEEK_SET", scm_from_int (SEEK_SET));
+  scm_c_define ("SEEK_CUR", scm_from_int (SEEK_CUR));
+  scm_c_define ("SEEK_END", scm_from_int (SEEK_END));
 
   scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port, 
                                           write_void_port);
+
+  cur_inport_fluid = scm_permanent_object (scm_make_fluid ());
+  cur_outport_fluid = scm_permanent_object (scm_make_fluid ());
+  cur_errport_fluid = scm_permanent_object (scm_make_fluid ());
+  cur_loadport_fluid = scm_permanent_object (scm_make_fluid ());
+
 #include "libguile/ports.x"
 }