* ports.h (scm_ptob_descriptor): include a write procedure again.

it's more efficient for unbuffered fports (e.g., sockets.)

	* ports.c (scm_puts): use ptob->write.
	* vports.c (scm_make_sfptob): set write proc in ptob.
	* strports.c (scm_make_stptob): set write proc in ptob.
	* ports.c (write_void_port): new procedure.
	* vports.c (sf_write): new procedure.
	* ports.c (scm_lfwrite): use ptob->write.
	* strports.c (st_write): new procedure.
	* fports.c (fport_write): new procedure.
	(scm_make_fptob): set write in ptob to fport_write.
	* ports.h: prototype for scm_set_port_write.
	* ports.c (scm_make_port_type): initialise ptob write procedure.
	(scm_set_port_write): new proc.

libguile/ChangeLog

@@ -1,3 +1,21 @@
+1999-08-03  Gary Houston  <ghouston@easynet.co.uk>
+
+	* ports.h (scm_ptob_descriptor): include a write procedure again.
+	it's more efficient for unbuffered fports (e.g., sockets.)
+
+	* ports.c (scm_puts): use ptob->write.
+	* vports.c (scm_make_sfptob): set write proc in ptob.
+	* strports.c (scm_make_stptob): set write proc in ptob.
+	* ports.c (write_void_port): new procedure.
+	* vports.c (sf_write): new procedure.
+	* ports.c (scm_lfwrite): use ptob->write.
+	* strports.c (st_write): new procedure.
+	* fports.c (fport_write): new procedure.
+	(scm_make_fptob): set write in ptob to fport_write.
+	* ports.h: prototype for scm_set_port_write.
+	* ports.c (scm_make_port_type): initialise ptob write procedure.
+	(scm_set_port_write): new proc.
+
 1999-08-01  Jim Blandy  <jimb@savonarola.red-bean.com>
 
 	* ports.c (scm_char_ready_p): Don't try to find PORT's ptab entry

libguile/fports.c

@@ -460,7 +460,43 @@ local_ftruncate (SCM port, off_t length)
     scm_syserror ("ftruncate");
 }
 
-/* becomes 1 when process is exiting: exception handling is disabled. */
+static void
+fport_write (SCM port, void *data, size_t size)
+{
+  scm_port *pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->write_buf == &pt->shortbuf)
+    {
+      /* "unbuffered" port.  */
+      int fdes = SCM_FSTREAM (port)->fdes;
+
+      if (write (fdes, data, size) == -1)
+	scm_syserror ("fport_write");
+    }
+  else 
+    {
+      const char *input = (char *) data;
+      while (size > 0)
+	{
+	  int space = pt->write_end - pt->write_pos;
+	  int write_len = (size > space) ? space : size;
+
+	  strncpy (pt->write_pos, input, write_len);
+	  pt->write_pos += write_len;
+	  size -= write_len;
+	  input += write_len;
+	  if (write_len == space)
+	    local_fflush (port);
+	}
+
+      /* handle line buffering.  */
+      if ((SCM_CAR (port) & SCM_BUFLINE) && memchr (data, '\n', size))
+	local_fflush (port);
+    }
+}
+
+/* becomes 1 when process is exiting: normal exception handling won't
+   work by this time.  */
 extern int terminating; 
 
 static void
@@ -570,6 +606,7 @@ scm_make_fptob ()
   long tc = scm_make_port_type ("file", fport_fill_buffer, local_fflush);
   scm_set_port_free            (tc, local_free);
   scm_set_port_print           (tc, prinfport);
+  scm_set_port_write           (tc, fport_write);
   scm_set_port_flush_input     (tc, local_read_flush);
   scm_set_port_close           (tc, local_fclose);
   scm_set_port_seek            (tc, local_seek);

libguile/ports.c

@@ -109,6 +109,7 @@ scm_markstream (ptr)
 
 static void flush_void_port (SCM port);
 static void read_flush_void_port (SCM port, int offset);
+static void write_void_port (SCM port, void *data, size_t size);
 
 long 
 scm_make_port_type (char *name,
@@ -130,6 +131,7 @@ scm_make_port_type (char *name,
       scm_ptobs[scm_numptob].free = scm_free0;
       scm_ptobs[scm_numptob].print = scm_port_print;
       scm_ptobs[scm_numptob].equalp = 0;
+      scm_ptobs[scm_numptob].write = write_void_port;
       scm_ptobs[scm_numptob].fflush = (write_flush
 				       ? write_flush
 				       : flush_void_port);
@@ -176,6 +178,13 @@ scm_set_port_equalp (long tc, SCM (*equalp) (SCM, SCM))
   scm_ptobs[SCM_TC2PTOBNUM (tc)].equalp = equalp;
 }
 
+void
+scm_set_port_write (long tc, void (*write_proc) (SCM port, void *data,
+						 size_t size))
+{
+   scm_ptobs[SCM_TC2PTOBNUM (tc)].write = write_proc;
+}
+
 void
 scm_set_port_flush_input (long tc, void (*flush_input) (SCM port, int offset))
 {
@@ -796,16 +805,7 @@ scm_puts (s, port)
   if (pt->rw_active == SCM_PORT_READ)
     scm_read_flush (port);
 
-  while (*s != 0)
+  ptob->write (port, s, strlen (s));
-    {
-      *pt->write_pos++ = *s++;
-      if (pt->write_pos == pt->write_end)
-	ptob->fflush (port);
-    }
-  /* If the port is line-buffered, flush it.  */
-  if ((SCM_CAR (port) & SCM_BUFLINE)
-      && memchr (pt->write_buf, '\n', pt->write_pos - pt->write_buf))
-    ptob->fflush (port);
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_WRITE;
@@ -823,22 +823,7 @@ scm_lfwrite (ptr, size, port)
   if (pt->rw_active == SCM_PORT_READ)
     scm_read_flush (port);
 
-  while (size > 0)
+  ptob->write (port, ptr, size);
-    {
-      int space = pt->write_end - pt->write_pos;
-      int write_len = (size > space) ? space : size;
-      
-      strncpy (pt->write_pos, ptr, write_len);
-      pt->write_pos += write_len;
-      size -= write_len;
-      ptr += write_len;
-      if (write_len == space)
-	ptob->fflush (port);
-    }
-  /* If the port is line-buffered, flush it.  */
-  if ((SCM_CAR (port) & SCM_BUFLINE)
-      && memchr (pt->write_buf, '\n', pt->write_pos - pt->write_buf))
-    (ptob->fflush) (port);
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_WRITE;
@@ -1288,6 +1273,11 @@ read_flush_void_port (SCM port, int offset)
 {
 }
 
+static void
+write_void_port (SCM port, void *data, size_t size)
+{
+}
+
 SCM
 scm_void_port (mode_str)
      char * mode_str;

libguile/ports.h

@@ -176,6 +176,7 @@ typedef struct scm_ptob_descriptor
   scm_sizet (*free) (SCM);
   int (*print) (SCM exp, SCM port, scm_print_state *pstate);
   SCM (*equalp) (SCM, SCM);
+  void (*write) (SCM port, void *data, size_t size);
   void (*fflush) (SCM port);
   void (*read_flush) (SCM port, int offset);
   int (*fclose) (SCM port);
@@ -209,6 +210,10 @@ extern void scm_set_port_print (long tc,
 					      SCM port,
 					      scm_print_state *pstate));
 extern void scm_set_port_equalp (long tc, SCM (*equalp) (SCM, SCM));
+extern void scm_set_port_write (long tc, 
+				void (*write_proc) (SCM port, 
+						    void *data,
+						    size_t size));
 extern void scm_set_port_flush_input (long tc,
 				      void (*flush_input) (SCM port,
 							   int offset));

libguile/strports.c

@@ -120,6 +120,26 @@ st_flush (SCM port)
   pt->rw_active = 0;
 }
 
+static void
+st_write (SCM port, void *data, size_t size)
+{
+  scm_port *pt = SCM_PTAB_ENTRY (port);
+  const char *input = (char *) data;
+
+  while (size > 0)
+    {
+      int space = pt->write_end - pt->write_pos;
+      int write_len = (size > space) ? space : size;
+      
+      strncpy (pt->write_pos, input, write_len);
+      pt->write_pos += write_len;
+      size -= write_len;
+      input += write_len;
+      if (write_len == space)
+	st_flush (port);
+    }
+}
+
 static void
 st_read_flush (SCM port, int offset)
 {
@@ -359,6 +379,7 @@ scm_make_stptob ()
   long tc = scm_make_port_type ("string", stfill_buffer, st_flush);
   scm_set_port_mark        (tc, scm_markstream);
   scm_set_port_flush_input (tc, st_read_flush);
+  scm_set_port_write       (tc, st_write);
   scm_set_port_seek        (tc, st_seek);
   scm_set_port_truncate    (tc, st_ftruncate);
 }

libguile/vports.c

@@ -82,7 +82,15 @@ sfflush (SCM port)
     }
 }
 
-/* string output proc (element 1) is no longer called.  */
+static void
+sf_write (SCM port, void *data, size_t size)
+{
+  SCM p = SCM_STREAM (port);
+
+  scm_apply (SCM_VELTS (p)[1], scm_cons (scm_makfrom0str ((char *) data),
+					 SCM_EOL),
+	     SCM_EOL);
+}
 
 /* calling the flush proc (element 2) is in case old code needs it,
    but perhaps softports could the use port buffer in the same way as
@@ -159,6 +167,7 @@ scm_make_sfptob ()
 {
   long tc = scm_make_port_type ("soft", sf_fill_buffer, sfflush);
   scm_set_port_mark (tc, scm_markstream);
+  scm_set_port_write (tc, sf_write);
   scm_set_port_close (tc, sfclose);
 }