* ioext.c (scm_read_string_x_partial): new procedure, implements

read-string!/partial.
	* ports.c (scm_take_from_input_buffers): new procedure used by
	scm_read_string_x_partial.
	(scm_drain_input): use scm_take_from_input_buffers.

libguile/ChangeLog

@@ -1,3 +1,11 @@
+2001-01-06  Gary Houston  <ghouston@arglist.com>
+
+	* ioext.c (scm_read_string_x_partial): new procedure, implements
+	read-string!/partial.
+	* ports.c (scm_take_from_input_buffers): new procedure used by
+	scm_read_string_x_partial.
+	(scm_drain_input): use scm_take_from_input_buffers.
+
 2001-01-06  Marius Vollmer  <mvo@zagadka.ping.de>
 
 	* validate.h (SCM_VALIDATE_NUMBER): New.

libguile/fports.c

@@ -486,9 +486,8 @@ fport_wait_for_input (SCM port)
 
 static void fport_flush (SCM port);
 
-/* fill a port's read-buffer with a single read.
+/* fill a port's read-buffer with a single read.  returns the first
-   returns the first char and moves the read_pos pointer past it.
+   char or EOF if end of file.  */
-   or returns EOF if end of file.  */
 static int
 fport_fill_input (SCM port)
 {

libguile/ioext.c

@@ -69,6 +69,110 @@
 #endif
 
 
+SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
+	    (SCM str, SCM port_or_fdes, SCM start, SCM end),
+	    "Read characters from an fport or file descriptor into a\n"
+	    "string @var{str}.  This procedure is scsh-compatible\n"
+	    "and can efficiently read large strings.  It will:\n\n"
+	    "@itemize\n"
+	    "@item\n"
+	    "attempt to fill the entire string, unless the @var{start}\n"
+	    "and/or @var{end} arguments are supplied.  i.e., @var{start}\n"
+	    "defaults to 0 and @var{end} defaults to\n"
+	    "@code{(string-length str)}\n"
+	    "@item\n"
+	    "use the current input port if @var{port_or_fdes} is not\n"
+	    "supplied.\n" 
+	    "@item\n"
+	    "read any characters that are currently available,\n"
+	    "without waiting for the rest (short reads are possible).\n\n"
+	    "@item\n"
+	    "wait for as long as it needs to for the first character to\n"
+	    "become available, unless the port is in non-blocking mode\n"
+	    "@item\n"
+	    "return @code{#f} if end-of-file is encountered before reading\n"
+            "any characters, otherwise return the number of characters\n"
+	    "read.\n"
+	    "@item\n"
+	    "return 0 if the port is in non-blocking mode and no characters\n"
+	    "are immediately available.\n"
+	    "@item\n"
+	    "return 0 if the request is for 0 bytes, with no\n"
+	    "end-of-file check\n"
+	    "@end itemize")
+#define FUNC_NAME s_scm_read_string_x_partial
+{
+  char *dest;
+  long read_len;
+  long chars_read = 0;
+  int fdes = -1;
+  SCM port = SCM_BOOL_F;
+
+  SCM_VALIDATE_STRING_COPY (1, str, dest);
+  if (SCM_UNBNDP (port_or_fdes))
+    port = scm_cur_inp;
+  else if (SCM_INUMP (port_or_fdes))
+    fdes = SCM_INUM (port_or_fdes);
+  else
+    {
+      SCM_VALIDATE_OPFPORT (2, port_or_fdes);
+      SCM_VALIDATE_INPUT_PORT (2, port_or_fdes);
+      port = port_or_fdes;
+    }
+
+  {
+    long string_len = SCM_STRING_LENGTH (str);
+    long offset = SCM_NUM2LONG_DEF (3, start, 0);
+    long last = SCM_NUM2LONG_DEF (4, end, string_len);
+
+    if (offset < 0 || offset > string_len)
+      SCM_OUT_OF_RANGE (3, start);
+    if (last < offset || last > string_len)
+      SCM_OUT_OF_RANGE (4, end);
+
+    dest += offset;
+    read_len = last - offset;
+  }
+
+  if (fdes == -1)
+    {
+      /* if there's anything in the port buffers, use it.  but if
+	 something is read from the buffers, don't touch the file
+	 descriptor.  otherwise the "return immediately if something
+	 is available" rule may be violated.  */
+      chars_read = scm_take_from_input_buffers (port, dest, read_len);
+
+    }
+
+  if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
+					  EOF.  */
+    {
+      if (fdes == -1)
+	fdes = SCM_FPORT_FDES (port);
+      
+      SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
+      if (chars_read == -1)
+	{
+#if defined (EWOULDBLOCK) || defined (EAGAIN)
+	  if (
+#if defined (EWOULDBLOCK)
+	      errno == EWOULDBLOCK
+#else
+	      errno == EAGAIN
+#endif
+	      )
+	    chars_read = 0;
+	  else
+#endif
+	    SCM_SYSERROR;
+        }
+      else if (chars_read == 0)
+	return SCM_BOOL_F;
+    }
+  return scm_long2num (chars_read);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
             (SCM delims, SCM buf, SCM gobble, SCM port, SCM start, SCM end),
 	    "Read characters from @var{port} into @var{buf} until one of the\n"

libguile/ioext.h

@@ -48,7 +48,10 @@
 
 
 
-extern SCM scm_read_delimited_x (SCM delims, SCM buf, SCM gobble, SCM port, SCM offset, SCM length);
+extern SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start,
+				      SCM end);
+extern SCM scm_read_delimited_x (SCM delims, SCM buf, SCM gobble, SCM port,
+				 SCM offset, SCM length);
 extern SCM scm_read_line (SCM port);
 extern SCM scm_write_line (SCM obj, SCM port);
 extern SCM scm_ftell (SCM object);

libguile/ports.c

@@ -272,6 +272,37 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+/* move up to read_len chars from port's putback and/or read buffers
+   into memory starting at dest.  returns the number of chars moved.  */
+size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
+{
+  scm_port *pt = SCM_PTAB_ENTRY (port);
+  size_t chars_read = 0;
+  size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
+
+  if (from_buf > 0)
+    {
+      memcpy (dest, pt->read_pos, from_buf);
+      pt->read_pos += from_buf;
+      chars_read += from_buf;
+      read_len -= from_buf;
+      dest += from_buf;
+    }
+
+  /* if putback was active, try the real input buffer too.  */
+  if (pt->read_buf == pt->putback_buf)
+    {
+      from_buf = min (pt->saved_read_end - pt->saved_read_pos, read_len);
+      if (from_buf > 0)
+	{
+	  memcpy (dest, pt->saved_read_pos, from_buf);
+	  pt->saved_read_pos += from_buf;
+	  chars_read += from_buf;
+	}
+    }
+  return chars_read;
+}
+
 /* Clear a port's read buffers, returning the contents.  */
 SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0, 
             (SCM port),
@@ -282,7 +313,6 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
   SCM result;
   scm_port *pt = SCM_PTAB_ENTRY (port);
   int count;
-  char *dst;
 
   SCM_VALIDATE_OPINPORT (1,port);
 
@@ -291,16 +321,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
     count += pt->saved_read_end - pt->saved_read_pos;
 
   result = scm_makstr (count, 0);
-  dst = SCM_STRING_CHARS (result);
+  scm_take_from_input_buffers (port, SCM_STRING_CHARS (result), count);
-
-  while (pt->read_pos < pt->read_end)
-    *dst++ = *(pt->read_pos++);
-  
-  if (pt->read_buf == pt->putback_buf)
-    {
-      while (pt->saved_read_pos < pt->saved_read_end)
-	*dst++ = *(pt->saved_read_pos++);
-    }
 
   return result;
 }

libguile/ports.h

@@ -244,6 +244,7 @@ extern void scm_set_port_truncate (long tc,
 						     off_t length));
 extern void scm_set_port_input_waiting (long tc, int (*input_waiting) (SCM));
 extern SCM scm_char_ready_p (SCM port);
+size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
 extern SCM scm_drain_input (SCM port);
 extern SCM scm_current_input_port (void);
 extern SCM scm_current_output_port (void);