Correction de race conditions entre I/O, GC, et marshaling (PR #24 et #25)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2794 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 44 insertions, 16 deletions

diff --git a/byterun/extern.c b/byterun/extern.c
index d0c7c4c4fc..8ad3a76ef3 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -391,12 +391,18 @@ static long extern_value(value v, value flags)
 void output_val(struct channel *chan, value v, value flags)
 {
   long len;
+  char * block;
+
   if (! channel_binary_mode(chan))
     failwith("output_value: not a binary channel");
   alloc_extern_block();
   len = extern_value(v, flags);
+  /* During really_putblock, concurrent output_val operations can take
+     place (via signal handlers or context switching in systhreads),
+     and extern_block may change.  So, save the pointer in a local variable. */
+  block = extern_block;
   really_putblock(chan, extern_block, len);
-  stat_free(extern_block);
+  stat_free(block);
 }
 
 value output_value(value vchan, value v, value flags) /* ML */
diff --git a/byterun/intern.c b/byterun/intern.c
index 1a33869110..7866749201 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -311,6 +311,7 @@ value input_val(struct channel *chan)
 {
   uint32 magic;
   mlsize_t block_len, num_objects, size_32, size_64, whsize;
+  char * block;
   value res;
 
   if (! channel_binary_mode(chan))
@@ -322,12 +323,17 @@ value input_val(struct channel *chan)
   size_32 = getword(chan);
   size_64 = getword(chan);
   /* Read block from channel */
-  intern_input = (unsigned char *) stat_alloc(block_len);
-  intern_input_malloced = 1;
-  if (really_getblock(chan, (char *)intern_input, block_len) == 0) {
-    stat_free(intern_input);
+  block = stat_alloc(block_len);
+  /* During really_gutblock, concurrent input_val operations can take
+     place (via signal handlers or context switching in systhreads),
+     and intern_input may change.  So, wait until really_getblock
+     is over before using intern_input and the other global vars. */
+  if (really_getblock(chan, block, block_len) == 0) {
+    stat_free(block);
     failwith("input_value: truncated object");
   }
+  intern_input = (unsigned char *) block;
+  intern_input_malloced = 1;
   intern_src = intern_input;
   /* Allocate result */
 #ifdef ARCH_SIXTYFOUR
diff --git a/byterun/io.c b/byterun/io.c
index 1f0e04be26..c90cc71f3b 100644
--- a/byterun/io.c
+++ b/byterun/io.c
@@ -284,7 +284,7 @@ int getblock(struct channel *channel, char *p, long int len)
     bcopy(channel->curr, p, avail);
     channel->curr += avail;
     return avail;
-  } else if (n < IO_BUFFER_SIZE) {
+  } else {
     nread = do_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
     channel->offset += nread;
     channel->max = channel->buff + nread;
@@ -292,10 +292,6 @@ int getblock(struct channel *channel, char *p, long int len)
     bcopy(channel->buff, p, n);
     channel->curr = channel->buff + n;
     return n;
-  } else {
-    nread = do_read(channel->fd, p, n);
-    channel->offset += nread;
-    return nread;
   }
 }
 
@@ -369,7 +365,7 @@ long input_scan_line(struct channel *channel)
 }
 
 /* Caml entry points for the I/O functions.  Wrap struct channel *
-   objects into a heap-allocated, finalized object.  Perform locking
+   objects into a heap-allocated object.  Perform locking
    and unlocking around the I/O operations. */
 
 static void finalize_channel(value vchan)
@@ -527,16 +523,36 @@ value caml_input_int(value vchannel)        /* ML */
   return Val_long(i);
 }
 
-value caml_input(value vchannel, value buff, value start, value length) /* ML */
+value caml_input(value vchannel, value buff, value vstart, value vlength) /* ML */
 {
-  CAMLparam4 (vchannel, buff, start, length);
+  CAMLparam4 (vchannel, buff, vstart, vlength);
   struct channel * channel = Channel(vchannel);
-  long res;
+  long start, len;
+  int n, avail, nread;
 
   Lock(channel);
-  res = getblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
+  /* We cannot call getblock here because buff may move during do_read */
+  start = Long_val(vstart);
+  len = Long_val(vlength);
+  n = len >= INT_MAX ? INT_MAX : (int) len;
+  avail = channel->max - channel->curr;
+  if (n <= avail) {
+    bcopy(channel->curr, &Byte(buff, start), n);
+    channel->curr += n;
+  } else if (avail > 0) {
+    bcopy(channel->curr, &Byte(buff, start), avail);
+    channel->curr += avail;
+    n = avail;
+  } else {
+    nread = do_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
+    channel->offset += nread;
+    channel->max = channel->buff + nread;
+    if (n > nread) n = nread;
+    bcopy(channel->buff, &Byte(buff, start), n);
+    channel->curr = channel->buff + n;
+  }
   Unlock(channel);
-  CAMLreturn (Val_long(res));
+  CAMLreturn (Val_long(n));
 }
 
 value caml_seek_in(value vchannel, value pos)     /* ML */