* Made the port implementations less tightly coupled within guile.
[bpt/guile.git] / libguile / fports.c
index 046bdf6..302303f 100644 (file)
@@ -48,8 +48,9 @@
 #include <fcntl.h>
 #include "libguile/_scm.h"
 #include "libguile/strings.h"
-
 #include "libguile/validate.h"
+#include "libguile/gc.h"
+
 #include "libguile/fports.h"
 
 #ifdef HAVE_STRING_H
@@ -68,6 +69,10 @@ scm_sizet fwrite ();
 
 #include "libguile/iselect.h"
 
+
+scm_bits_t scm_tc16_fport;
+
+
 /* default buffer size, used if the O/S won't supply a value.  */
 static const int default_buffer_size = 1024;
 
@@ -306,8 +311,12 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
        case '+':
          flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR;
          break;
+       case 'b':
+#if defined (O_BINARY)
+         flags |= O_BINARY;
+#endif
+         break;
        case '0':  /* unbuffered: handled later.  */
-       case 'b':  /* 'binary' mode: ignored.  */
        case 'l':  /* line buffered: handled during output.  */
          break;
        default:
@@ -422,7 +431,7 @@ fport_input_waiting (SCM port)
 
 \f
 static int 
-prinfport (SCM exp,SCM port,scm_print_state *pstate)
+fport_print (SCM exp, SCM port, scm_print_state *pstate)
 {
   scm_puts ("#<", port);
   scm_print_port_mode (exp, port);    
@@ -481,9 +490,8 @@ fport_wait_for_input (SCM port)
 
 static void fport_flush (SCM port);
 
-/* fill a port's read-buffer with a single read.
-   returns the first char and moves the read_pos pointer past it.
-   or returns EOF if end of file.  */
+/* fill a port's read-buffer with a single read.  returns the first
+   char or EOF if end of file.  */
 static int
 fport_fill_input (SCM port)
 {
@@ -568,41 +576,83 @@ fport_truncate (SCM port, off_t length)
     scm_syserror ("ftruncate");
 }
 
+/* helper for fport_write: try to write data, using multiple system
+   calls if required.  */
+#define FUNC_NAME "write_all"
+static void write_all (SCM port, const void *data, size_t remaining)
+{
+  int fdes = SCM_FSTREAM (port)->fdes;
+
+  while (remaining > 0)
+    {
+      ssize_t done;
+
+      SCM_SYSCALL (done = write (fdes, data, remaining));
+
+      if (done == -1)
+       SCM_SYSERROR;
+      remaining -= done;
+      data = ((const char *) data) + done;
+    }
+}
+#undef FUNC_NAME
+
 static void
 fport_write (SCM port, const void *data, size_t size)
 {
+  /* this procedure tries to minimize the number of writes/flushes.  */
   scm_port *pt = SCM_PTAB_ENTRY (port);
 
-  if (pt->write_buf == &pt->shortbuf)
+  if (pt->write_buf == &pt->shortbuf
+      || (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
     {
-      /* "unbuffered" port.  */
-      int fdes = SCM_FSTREAM (port)->fdes;
-
-      if (write (fdes, data, size) == -1)
-       scm_syserror ("fport_write");
+      /* "unbuffered" port, or
+        port with empty buffer and data won't fit in buffer. */
+      write_all (port, data, size);
+      return;
     }
-  else 
-    {
-      const char *input = (char *) data;
-      size_t remaining = size;
 
-      while (remaining > 0)
-       {
-         int space = pt->write_end - pt->write_pos;
-         int write_len = (remaining > space) ? space : remaining;
-
-         memcpy (pt->write_pos, input, write_len);
-         pt->write_pos += write_len;
-         remaining -= write_len;
-         input += write_len;
-         if (write_len == space)
+  {
+    off_t space = pt->write_end - pt->write_pos;
+
+    if (size <= space)
+      {
+       /* data fits in buffer.  */
+       memcpy (pt->write_pos, data, size);
+       pt->write_pos += size;
+       if (pt->write_pos == pt->write_end)
+         {
            fport_flush (port);
+           /* we can skip the line-buffering check if nothing's buffered. */
+           return;
+         }
+      }
+    else
+      {
+       memcpy (pt->write_pos, data, space);
+       pt->write_pos = pt->write_end;
+       fport_flush (port);
+       {
+         const void *ptr = ((const char *) data) + space;
+         size_t remaining = size - space;
+
+         if (size >= pt->write_buf_size)
+           {
+             write_all (port, ptr, remaining);
+             return;
+           }
+         else
+           {
+             memcpy (pt->write_pos, ptr, remaining);
+             pt->write_pos += remaining;
+           }
        }
+      }
 
-      /* handle line buffering.  */
-      if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE) && memchr (data, '\n', size))
-       fport_flush (port);
-    }
+    /* handle line buffering.  */     
+    if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE) && memchr (data, '\n', size))
+      fport_flush (port);
+  }
 }
 
 /* becomes 1 when process is exiting: normal exception handling won't
@@ -639,9 +689,7 @@ fport_flush (SCM port)
                }
              pt->write_pos = pt->write_buf + remaining;
            }
-         if (!terminating)
-           scm_syserror ("fport_flush");
-         else
+         if (terminating)
            {
              const char *msg = "Error: could not flush file-descriptor ";
              char buf[11];
@@ -652,6 +700,14 @@ fport_flush (SCM port)
 
              count = remaining;
            }
+         else if (scm_gc_running_p)
+           {
+             /* silently ignore the error.  scm_error would abort if we
+                called it now.  */
+             count = remaining;
+           }
+         else
+           scm_syserror ("fport_flush");
        }
       ptr += count;
       remaining -= count;
@@ -690,7 +746,14 @@ fport_close (SCM port)
   fport_flush (port);
   SCM_SYSCALL (rv = close (fp->fdes));
   if (rv == -1 && errno != EBADF)
-    scm_syserror ("fport_close");
+    {
+      if (scm_gc_running_p)
+       /* silently ignore the error.  scm_error would abort if we
+          called it now.  */
+       ;
+      else
+       scm_syserror ("fport_close");
+    }
   if (pt->read_buf == pt->putback_buf)
     pt->read_buf = pt->saved_read_buf;
   if (pt->read_buf != &pt->shortbuf)
@@ -708,29 +771,35 @@ fport_free (SCM port)
   return 0;
 }
 
-void scm_make_fptob (void); /* Called from ports.c */
-
-void
+static scm_bits_t
 scm_make_fptob ()
 {
-  long tc = scm_make_port_type ("file", fport_fill_input, fport_write);
+  scm_bits_t tc = scm_make_port_type ("file", fport_fill_input, fport_write);
+
   scm_set_port_free            (tc, fport_free);
-  scm_set_port_print           (tc, prinfport);
+  scm_set_port_print           (tc, fport_print);
   scm_set_port_flush           (tc, fport_flush);
   scm_set_port_end_input       (tc, fport_end_input);
   scm_set_port_close           (tc, fport_close);
   scm_set_port_seek            (tc, fport_seek);
   scm_set_port_truncate        (tc, fport_truncate);
   scm_set_port_input_waiting   (tc, fport_input_waiting);
+
+  return tc;
 }
 
 void
 scm_init_fports ()
 {
-#include "libguile/fports.x"
+  scm_tc16_fport = scm_make_fptob ();
+
   scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
   scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
   scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/fports.x"
+#endif
 }
 
 /*