[MLton-devel] cvs commit: bug fix for StreamIO space leak

Stephen Weeks sweeks@users.sourceforge.net
Mon, 13 Oct 2003 17:10:13 -0700


sweeks      03/10/13 17:10:13

  Modified:    basis-library/io imperative-io.fun stream-io.fun
                        stream-io.sig
  Log:
  I didn't use Jared's patch, but I did use a similar approach.  Now,
  instead of keeping a list of open instreams, we keep a list of close
  functions that have just enough information to close the instream.  In
  particular, they do not keep the whole instream alive.

Revision  Changes    Path
1.8       +2 -0      mlton/basis-library/io/imperative-io.fun

Index: imperative-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/imperative-io.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- imperative-io.fun	24 Sep 2003 17:45:25 -0000	1.7
+++ imperative-io.fun	14 Oct 2003 00:10:13 -0000	1.8
@@ -98,6 +98,8 @@
 		    structure StreamIO =
 		      struct
 			open StreamIO
+			fun makeCloseIn _ = raise Fail "<makeCloseIn>"
+			fun instreamUniq _ = raise Fail "<instreamUniq>"
 			fun input1' _ = raise (Fail "<input1'>")
 			fun equalsIn _ = raise (Fail "<equalsIn>")
 			fun instreamReader _ = raise (Fail "<instreamReader>")



1.17      +39 -29    mlton/basis-library/io/stream-io.fun

Index: stream-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.fun,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- stream-io.fun	9 Oct 2003 18:17:29 -0000	1.16
+++ stream-io.fun	14 Oct 2003 00:10:13 -0000	1.17
@@ -297,7 +297,8 @@
 
       datatype instream = In of {common: {reader: reader,
 					  augmented_reader: reader,
-					  tail: state ref ref},
+					  tail: state ref ref,
+					  uniq: unit ref},
 				 pos: int,
 				 buf: buf}
 
@@ -323,6 +324,7 @@
       fun instreamReader is = instreamCommonSel (is, #reader)
       fun readerSel (PIO.RD v, sel) = sel v
       fun instreamName is = readerSel (instreamReader is, #name)
+      fun instreamUniq is = instreamCommonSel (is, #uniq)
 
       val empty = V.tabulate (0, fn _ => someElem)
       val line = V.tabulate (1, fn _ => lineElem)
@@ -598,12 +600,17 @@
 		      | _ => SOME 0
 	     end
 
-      fun closeIn (is as In {common = {tail, ...}, ...}) =
-	case !(!tail) of
-	  End => (!tail := Closed;
-		  ((readerSel (instreamReader is, #close)) ())
-		  handle exn => liftExn (instreamName is) "closeIn" exn)
-	| _ => ()
+      fun makeCloseIn (In {common = {reader = PIO.RD {close, name, ...},
+				     tail, ...},
+			   ...}): unit -> unit =
+	 fn () =>
+	 case !(!tail) of
+	    End =>
+	       (!tail := Closed
+		; close () handle exn => liftExn name "closeIn" exn)
+	  | _ => ()
+
+      fun closeIn ins = makeCloseIn ins ()
 
       fun endOfStream is =
 	let val (inp, _) = input is
@@ -634,7 +641,8 @@
 	in
 	  In {common = {reader = reader,
 			augmented_reader = PIO.augmentReader reader,
-			tail = ref next},
+			tail = ref next,
+			uniq = ref ()},
 	      pos = 0,
 	      buf = buf}
 	end
@@ -788,24 +796,25 @@
 	  SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
 	| NONE => liftExn (instreamName is) "inFd" (Fail "<no ioDesc>")
 
-      val openInstreams : (instream * {close: bool}) list ref = ref []
+      val closeAtExits: {close: unit -> unit, uniq: unit ref} list ref = ref []
       val mkInstream'' =
 	let
-	  val _ = Cleaner.addNew
-	          (Cleaner.atExit, fn () =>
-		   List.app (fn (is, {close}) => 
-			     if close
-			       then closeIn is
-			       else ()) (!openInstreams))
+	   val _ = Cleaner.addNew (Cleaner.atExit, fn () =>
+				   List.app (fn {close, ...} => close ())
+				   (!closeAtExits))
 	in
-	  fn {reader, closed, buffer_contents, atExit} =>
+	  fn {reader, closed, buffer_contents, atExit = {close = closeAtExit}} =>
 	  let
-	    val is = mkInstream' {reader = reader,
-				  closed = closed,
-				  buffer_contents = buffer_contents}
-	    val _ = if closed
-		      then ()
-		      else openInstreams := (is,atExit) :: (!openInstreams)
+	    val is =
+	       mkInstream' {reader = reader,
+			    closed = closed,
+			    buffer_contents = buffer_contents}
+	    val _ =
+	       if closed orelse not closeAtExit
+		  then ()
+	       else closeAtExits := ({close = makeCloseIn is,
+				      uniq = instreamUniq is}
+				     :: (!closeAtExits))
 	  in
 	    is
 	  end
@@ -820,11 +829,12 @@
 					 then NONE
 					 else SOME buffer_contents}
       val closeIn = fn is =>
-	let
-	  val _ = openInstreams := List.filter (fn (is',_) => 
-						not (equalsIn (is, is'))) 
-                                               (!openInstreams)
-	in
-	  closeIn is
-	end
+	 let
+	    val u = instreamUniq is
+	    val _ =
+	       closeAtExits :=
+	       List.filter (fn {uniq, ...} => u = uniq) (!closeAtExits)
+	 in
+	    closeIn is
+	 end
    end



1.7       +2 -1      mlton/basis-library/io/stream-io.sig

Index: stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- stream-io.sig	24 Sep 2003 17:45:25 -0000	1.6
+++ stream-io.sig	14 Oct 2003 00:10:13 -0000	1.7
@@ -37,8 +37,8 @@
       include STREAM_IO
 
       val input1': instream -> elem option * instream
-      val equalsIn: instream * instream -> bool
       val instreamReader: instream -> reader
+      val makeCloseIn: instream -> unit -> unit
       val mkInstream': {reader: reader,
 			closed: bool,
 			buffer_contents: vector option} -> instream
@@ -52,6 +52,7 @@
       val openVector: vector -> instream
       val inputLine: instream -> (vector * instream) option
       val outputSlice: outstream * (vector * int * int option) -> unit
+      val instreamUniq: instream -> unit ref
    end
 
 signature STREAM_IO_EXTRA_FILE =




-------------------------------------------------------
This SF.net email is sponsored by: SF.net Giveback Program.
SourceForge.net hosts over 70,000 Open Source Projects.
See the people who have HELPED US provide better services:
Click here: http://sourceforge.net/supporters.php
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel