[Gd-chatter] r11163 - in trunk/fundev/sources/io: . streams

hannes at gwydiondylan.org hannes at gwydiondylan.org
Sat Feb 3 00:32:15 CET 2007


Author: hannes
Date: Sat Feb  3 00:32:13 2007
New Revision: 11163

Modified:
   trunk/fundev/sources/io/streams/buffered-stream.dylan
   trunk/fundev/sources/io/streams/stream.dylan
   trunk/fundev/sources/io/unix-standard-io.dylan
Log:
Bug: 7183
properly lock access to streams


Modified: trunk/fundev/sources/io/streams/buffered-stream.dylan
==============================================================================
--- trunk/fundev/sources/io/streams/buffered-stream.dylan	(original)
+++ trunk/fundev/sources/io/streams/buffered-stream.dylan	Sat Feb  3 00:32:13 2007
@@ -159,9 +159,11 @@
        ?body:body
      end }
   => { begin
-	 let ?buffer :: false-or(<buffer>) 
-	   = get-input-buffer(?stream, bytes: ?bytes);
-	 ?body
+         with-stream-locked(?stream)
+           let ?buffer :: false-or(<buffer>) 
+             = get-input-buffer(?stream, bytes: ?bytes);
+           ?body
+         end
        end }
 end macro with-input-buffer;
 
@@ -171,6 +173,7 @@
 define inline function get-output-buffer
     (stream :: <buffered-stream>, #key bytes = 1)
  => (buffer :: false-or(<buffer>))
+  with-stream-locked(stream)
   let sb = stream-output-buffer(stream);
   if (sb)
     let sb :: <buffer> = sb; // HACK: TYPE ONLY
@@ -182,6 +185,7 @@
   else
     do-get-output-buffer(stream, bytes: bytes)
   end
+  end
 end function get-output-buffer;
 
 // No default method for this
@@ -220,9 +224,11 @@
       ?body:body
     end }
   => { begin
-	 let ?buffer :: false-or(<buffer>)
-	   = get-output-buffer(?stream, bytes: ?bytes);
-	 ?body
+         with-stream-locked(?stream)
+           let ?buffer :: false-or(<buffer>)
+             = get-output-buffer(?stream, bytes: ?bytes);
+           ?body
+         end
        end }
 end macro with-output-buffer;
 
@@ -363,6 +369,7 @@
 // next and  end pointers reset by this method.
 define method do-force-output-buffers
     (stream :: <double-buffered-stream>) => ()
+  with-stream-locked(stream)
   // This method ignores the buffer-dirty? flag.  This is backward
   // compatible with the old streams library.
   let sb :: <buffer> = stream-output-buffer(stream);
@@ -381,6 +388,7 @@
   // discretion of subclasses.  Aligned buffers for instance should not
   // have their pointers reset.
   values()
+  end;
 end method do-force-output-buffers;
 
 
@@ -719,6 +727,7 @@
 define method write
     (stream :: <buffered-stream>, elements :: <sequence>,
      #key start: _start :: <integer> = 0, end: _end = #f) => ()
+  with-stream-locked(stream)
   with-output-buffer (sb = stream)
     let e :: <integer> = _end | elements.size;
     iterate loop (i :: <integer> = _start, sb :: false-or(<buffer>) = sb)
@@ -743,6 +752,7 @@
       end
     end iterate
   end
+  end
 end method write;
 
 

Modified: trunk/fundev/sources/io/streams/stream.dylan
==============================================================================
--- trunk/fundev/sources/io/streams/stream.dylan	(original)
+++ trunk/fundev/sources/io/streams/stream.dylan	Sat Feb  3 00:32:13 2007
@@ -137,11 +137,6 @@
   the-stream.private-stream-lock-value
 end method stream-lock;
 
-define method stream-lock-setter
-    (the-lock, the-stream :: <basic-stream>) => (result)
-  the-stream.private-stream-lock-value := the-lock;
-  the-lock
-end method stream-lock-setter;
 
 /// Stream query functions, common to all streams
 

Modified: trunk/fundev/sources/io/unix-standard-io.dylan
==============================================================================
--- trunk/fundev/sources/io/unix-standard-io.dylan	(original)
+++ trunk/fundev/sources/io/unix-standard-io.dylan	Sat Feb  3 00:32:13 2007
@@ -121,9 +121,11 @@
   = make(<console-stream>, file-descriptor: 2, direction: #"output");
 
 define function flush-stdout () => ()
-  let ob = stream-output-buffer(*standard-output*);
-  if (ob & ~(ob.buffer-start = ob.buffer-end))
-    force-output(*standard-output*)
+  with-stream-locked(*standard-output*)
+    let ob = stream-output-buffer(*standard-output*);
+    if (ob & ~(ob.buffer-start = ob.buffer-end))
+      force-output(*standard-output*)
+    end
   end
 end function flush-stdout;
 
@@ -133,14 +135,16 @@
 define method close
     (stream :: <console-stream>,
      #key abort? = #f) => ()
-  unless (abort?)
-    if (stream.stream-direction == #"output") 
-      let ob = stream-output-buffer(stream);
-      if (ob & ~(ob.buffer-start = ob.buffer-end))
-	force-output(stream);
+  with-stream-locked(stream)
+    unless (abort?)
+      if (stream.stream-direction == #"output") 
+        let ob = stream-output-buffer(stream);
+        if (ob & ~(ob.buffer-start = ob.buffer-end))
+          force-output(stream);
+        end if;
       end if;
-    end if;
-  end;
+    end;
+  end
   //  DON'T CALL NEXT-METHOD()!! Lower level close methods shouldn't
   //  be called on console streams.
 end method close;
@@ -149,9 +153,11 @@
 
 define method stream-input-available?
     (stream :: <console-stream>) => (input-available? :: <boolean>)
-  stream-direction(stream) = #"input"
-  & (stream-input-buffer(stream).buffer-next < stream-input-buffer(stream).buffer-end
-     | do-input-available-at-source?(stream))
+  with-stream-locked(stream)
+    stream-direction(stream) = #"input"
+      & (stream-input-buffer(stream).buffer-next < stream-input-buffer(stream).buffer-end
+           | do-input-available-at-source?(stream))
+  end
 end method stream-input-available?;
 
 define method do-input-available-at-source?
@@ -201,15 +207,17 @@
     (accessor :: <console-stream-accessor>, stream :: <console-stream>,
      offset :: <buffer-index>, count :: <buffer-index>, #key buffer)
  => (nread :: <integer>)
-  ignore(accessor);
-  let bufv = as(<vector>, buffer | stream-input-buffer(stream));
-  // N.B. No checking for sufficient length, e.g.
-  // if (offset + count > buffer.size) error "Argh!!" end;
-  let nread = unix-read(stream.file-descriptor, bufv, offset, count);
-  if (nread < 0)
-    unix-error("read");
-  end if;
-  nread
+  with-stream-locked(stream)
+    ignore(accessor);
+    let bufv = as(<vector>, buffer | stream-input-buffer(stream));
+    // N.B. No checking for sufficient length, e.g.
+    // if (offset + count > buffer.size) error "Argh!!" end;
+    let nread = unix-read(stream.file-descriptor, bufv, offset, count);
+    if (nread < 0)
+      unix-error("read");
+    end if;
+    nread
+  end
 end method accessor-read-into!;
 
 
@@ -217,23 +225,29 @@
 
 define method write-element
     (stream :: <console-stream>, element :: <character>) => ()
-  next-method();
-  if (element == '\n' | element == '\r')
-    force-output(stream)
+  with-stream-locked(stream)
+    next-method();
+    if (element == '\n' | element == '\r')
+      force-output(stream)
+    end
   end
 end method write-element;
 
 define method write-line
     (stream :: <console-stream>, elements :: <string>,
      #key start: _start = 0, end: _end = #f) => ()
-  next-method();
-  force-output(stream);
+  with-stream-locked(stream)
+    next-method();
+    force-output(stream);
+  end
 end method write-line;
 
 define method new-line
     (stream :: <console-stream>) => ()
-  next-method();
-  force-output(stream)
+  with-stream-locked(stream)
+    next-method();
+    force-output(stream)
+  end
 end method new-line;
 
 define method accessor-write-from
@@ -241,26 +255,28 @@
      offset :: <buffer-index>, count :: <buffer-index>, #key buffer,
      return-fresh-buffer? = #f)
  => (number-of-bytes-written :: <integer>, new-buffer :: <buffer>)
-  ignore(accessor);
-  let buffer = buffer | stream-output-buffer(stream);
-  let bufv = as(<vector>, buffer);
-  // N.B. No checking for sufficient length, e.g.
-  // if (offset + count > buffer.size) error "Argh!!" end;
-  let total-written = 0;
-  local method try-writing ()
-          let nwritten = unix-write(stream.file-descriptor,
-                                    bufv, offset, count);
-          total-written := total-written + nwritten;
-          if (nwritten < 0)
-            unix-error("write")
-          elseif (nwritten < count)
-            count := count - nwritten;
-            offset := offset + nwritten;
-            try-writing();
-          end if;
-        end;
-  try-writing();
-  values(total-written, buffer)
+  with-stream-locked(stream)
+    ignore(accessor);
+    let buffer = buffer | stream-output-buffer(stream);
+    let bufv = as(<vector>, buffer);
+    // N.B. No checking for sufficient length, e.g.
+    // if (offset + count > buffer.size) error "Argh!!" end;
+    let total-written = 0;
+    local method try-writing ()
+            let nwritten = unix-write(stream.file-descriptor,
+                                      bufv, offset, count);
+            total-written := total-written + nwritten;
+            if (nwritten < 0)
+              unix-error("write")
+            elseif (nwritten < count)
+              count := count - nwritten;
+              offset := offset + nwritten;
+              try-writing();
+            end if;
+          end;
+    try-writing();
+    values(total-written, buffer)
+  end
 end method accessor-write-from;
 
 define method accessor-force-output
@@ -272,13 +288,15 @@
 
 define method do-force-output-buffers
     (stream :: <console-stream>) => ()
-  next-method();
-  let sb :: <buffer> = stream-output-buffer(stream);
-  sb.buffer-next := 0;
-  sb.buffer-end := 0;
-  values()
+  with-stream-locked(stream)
+    next-method();
+    let sb :: <buffer> = stream-output-buffer(stream);
+    sb.buffer-next := 0;
+    sb.buffer-end := 0;
+    values()
+  end
 end method do-force-output-buffers;
-
+  
 define method accessor-newline-sequence
     (accessor :: <console-stream-accessor>)
  => (newline-sequence :: <sequence>);



More information about the chatter mailing list