Merge branch 'master' into boehm-demers-weiser-gc

libguile/numbers.c

@@ -1022,7 +1022,7 @@ SCM
 scm_gcd (SCM x, SCM y)
 {
   if (SCM_UNBNDP (y))
-    return SCM_UNBNDP (x) ? SCM_INUM0 : x;
+    return SCM_UNBNDP (x) ? SCM_INUM0 : scm_abs (x);
   
   if (SCM_I_INUMP (x))
     {

libguile/ports.c

@@ -28,6 +28,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <fcntl.h>  /* for chsize on mingw */
+#include <assert.h>
 
 #include <assert.h>
 
@@ -1012,6 +1013,8 @@ scm_fill_input (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
+  assert (pt->read_pos == pt->read_end);
+
   if (pt->read_buf == pt->putback_buf)
     {
       /* finished reading put-back chars.  */
@@ -1074,12 +1077,39 @@ scm_lfwrite (const char *ptr, size_t size, SCM port)
  *
  * Warning: Doesn't update port line and column counts!  */
 
+/* This structure, and the following swap_buffer function, are used
+   for temporarily swapping a port's own read buffer, and the buffer
+   that the caller of scm_c_read provides. */
+struct port_and_swap_buffer
+{
+  scm_t_port *pt;
+  unsigned char *buffer;
+  size_t size;
+};
+
+static void
+swap_buffer (void *data)
+{
+  struct port_and_swap_buffer *psb = (struct port_and_swap_buffer *) data;
+  unsigned char *old_buf = psb->pt->read_buf;
+  size_t old_size = psb->pt->read_buf_size;
+
+  /* Make the port use (buffer, size) from the struct. */
+  psb->pt->read_pos = psb->pt->read_buf = psb->pt->read_end = psb->buffer;
+  psb->pt->read_buf_size = psb->size;
+
+  /* Save the port's old (buffer, size) in the struct. */
+  psb->buffer = old_buf;
+  psb->size = old_size;
+}
+
 size_t
 scm_c_read (SCM port, void *buffer, size_t size)
 #define FUNC_NAME "scm_c_read"
 {
   scm_t_port *pt;
   size_t n_read = 0, n_available;
+  struct port_and_swap_buffer psb;
 
   SCM_VALIDATE_OPINPORT (1, port);
 
@@ -1090,35 +1120,52 @@ scm_c_read (SCM port, void *buffer, size_t size)
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_READ;
 
-  if (SCM_READ_BUFFER_EMPTY_P (pt))
-    {
-      if (scm_fill_input (port) == EOF)
-	return 0;
-    }
-  
-  n_available = pt->read_end - pt->read_pos;
-  
-  while (n_available < size)
+  /* Take bytes first from the port's read buffer. */
+  if (pt->read_pos < pt->read_end)
     {
+      n_available = min (size, pt->read_end - pt->read_pos);
       memcpy (buffer, pt->read_pos, n_available);
       buffer = (char *) buffer + n_available;
       pt->read_pos += n_available;
       n_read += n_available;
-      
-      if (SCM_READ_BUFFER_EMPTY_P (pt))
-	{
-	  if (scm_fill_input (port) == EOF)
-	    return n_read;
-	}
-
       size -= n_available;
-      n_available = pt->read_end - pt->read_pos;
     }
 
-  memcpy (buffer, pt->read_pos, size);
-  pt->read_pos += size;
+  /* Avoid the scm_dynwind_* costs if we now have enough data. */
+  if (size == 0)
+    return n_read;
 
-  return n_read + size;
+  /* Now we will call scm_fill_input repeatedly until we have read the
+     requested number of bytes.  (Note that a single scm_fill_input
+     call does not guarantee to fill the whole of the port's read
+     buffer.)  For these calls, since we already have a buffer here to
+     read into, we bypass the port's own read buffer (if it has one),
+     by saving it off and modifying the port structure to point to our
+     own buffer.
+
+     We need to make sure that the port's normal buffer is reinstated
+     in case one of the scm_fill_input () calls throws an exception;
+     we use the scm_dynwind_* API to achieve that. */
+  psb.pt = pt;
+  psb.buffer = buffer;
+  psb.size = size;
+  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+  scm_dynwind_rewind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY);
+  scm_dynwind_unwind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY);
+
+  /* Call scm_fill_input until we have all the bytes that we need, or
+     we hit EOF. */
+  while (pt->read_buf_size && (scm_fill_input (port) != EOF))
+    {
+      pt->read_buf_size -= (pt->read_end - pt->read_pos);
+      pt->read_pos = pt->read_buf = pt->read_end;
+    }
+  n_read += pt->read_buf - (unsigned char *) buffer;
+
+  /* Reinstate the port's normal buffer. */
+  scm_dynwind_end ();
+
+  return n_read;
 }
 #undef FUNC_NAME
 

libguile/read.c

@@ -484,7 +484,7 @@ scm_read_string (int chr, SCM port)
   else
     str = (str == SCM_BOOL_F) ? scm_nullstr : str;
 
-  return str;
+  return scm_i_make_read_only_string (str);
 }
 #undef FUNC_NAME
 

libguile/srfi-4.c

@@ -858,38 +858,11 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
 
   if (SCM_NIMP (port_or_fd))
     {
-      scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
-
-      if (pt->rw_active == SCM_PORT_WRITE)
-	scm_flush (port_or_fd);
-
       ans = cend - cstart;
-      while (remaining > 0)
-	{
-	  if (pt->read_pos < pt->read_end)
-	    {
-	      size_t to_copy = min (pt->read_end - pt->read_pos,
-				    remaining);
-	      
-	      memcpy (base + off, pt->read_pos, to_copy);
-	      pt->read_pos += to_copy;
-	      remaining -= to_copy;
-	      off += to_copy;
-	    }
-	  else
-	    {
-	      if (scm_fill_input (port_or_fd) == EOF)
-		{
-		  if (remaining % sz != 0)
-		    SCM_MISC_ERROR ("unexpected EOF", SCM_EOL);
-		  ans -= remaining / sz;
-		  break;
-		}
-	    }
-	}
-      
-      if (pt->rw_random)
-	pt->rw_active = SCM_PORT_READ;
+      remaining -= scm_c_read (port_or_fd, base + off, remaining);
+      if (remaining % sz != 0)
+        SCM_MISC_ERROR ("unexpected EOF", SCM_EOL);
+      ans -= remaining / sz;
     }
   else /* file descriptor.  */
     {

libguile/strings.c

@@ -204,6 +204,12 @@ get_str_buf_start (SCM *str, SCM *buf, size_t *start)
   *buf = STRING_STRINGBUF (*str);
 }
 
+SCM
+scm_i_make_read_only_string (SCM str)
+{
+  return scm_i_substring_read_only (str, 0, STRING_LENGTH (str));
+}
+
 SCM
 scm_i_substring (SCM str, size_t start, size_t end)
 {
@@ -221,15 +227,28 @@ scm_i_substring (SCM str, size_t start, size_t end)
 SCM
 scm_i_substring_read_only (SCM str, size_t start, size_t end)
 {
-  SCM buf;
-  size_t str_start;
-  get_str_buf_start (&str, &buf, &str_start);
-  scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
-  SET_STRINGBUF_SHARED (buf);
-  scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
-  return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf),
-			  (scm_t_bits)str_start + start,
-			  (scm_t_bits) end - start);
+  SCM result;
+
+  if (SCM_UNLIKELY (STRING_LENGTH (str) == 0))
+    /* We want the empty string to be `eq?' with the read-only empty
+       string.  */
+    result = str;
+  else
+    {
+      SCM buf;
+      size_t str_start;
+
+      get_str_buf_start (&str, &buf, &str_start);
+      scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
+      SET_STRINGBUF_SHARED (buf);
+      scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
+
+      result = scm_double_cell (RO_STRING_TAG, SCM_UNPACK (buf),
+				(scm_t_bits) str_start + start,
+				(scm_t_bits) end - start);
+    }
+
+  return result;
 }
 
 SCM
@@ -457,7 +476,7 @@ scm_i_symbol_substring (SCM sym, size_t start, size_t end)
   scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
   SET_STRINGBUF_SHARED (buf);
   scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
-  return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
+  return scm_double_cell (RO_STRING_TAG, SCM_UNPACK (buf),
 			  (scm_t_bits)start, (scm_t_bits) end - start);
 }
 

libguile/strings.h

@@ -143,6 +143,7 @@ SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
 					    SCM start, size_t *cstart,
 					    SCM end, size_t *cend);
 SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
+SCM_INTERNAL SCM scm_i_make_read_only_string (SCM str);
 
 /* deprecated stuff */