[MLton] cvs commit: added expert flag -contify-into-main {false|true}

[Stephen Weeks]

sweeks      04/06/02 10:36:44

  Modified:    mlton/control control.sig control.sml
               mlton/main main.fun
               mlton/ssa contify.fun
  Log:
  MAIL added expert flag -contify-into-main {false|true}
  
  This flag controls whether contification will contify functions into
  main.  We did allow this, but doing so can increase the size of main.
  
  I ran the benchmarks -contify-into-main {true,false}.  Here are the
  run time ratios that were more than 0.02 away from 1.
  
  MLton0 -- mlton -contify-into-main true
  MLton1 -- mlton -contify-into-main false
  
  run time ratio
  benchmark         MLton1
  checksum            0.94
  fft                 1.04
  fib                 0.94
  hamlet              0.97
  lexgen              1.04
  mandelbrot          0.96
  matrix-multiply     0.81
  mlyacc              0.96
  nucleic             1.09
  ray                 0.83
  raytrace            1.04
  simple              1.09
  tensor              1.04
  vliw                0.96
  wc-input1           0.90
  
  There were no major code-size or compile-time differences.  I have no
  explanation for the speedups on matrix-multiply and ray.  In any case,
  since the benchmarks seem OK, I've gone ahead and made
  -contify-into-main false the default.

Revision  Changes    Path
1.99      +2 -0      mlton/mlton/control/control.sig

Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -r1.98 -r1.99
--- control.sig	31 May 2004 21:37:56 -0000	1.98
+++ control.sig	2 Jun 2004 17:36:43 -0000	1.99
@@ -45,6 +45,8 @@
 
       val codegen: codegen ref
 
+      val contifyIntoMain: bool ref
+
       val deadCode: bool ref
 	 
       (* Generate an executable with debugging info. *)



1.123     +4 -0      mlton/mlton/control/control.sml

Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.122
retrieving revision 1.123
diff -u -r1.122 -r1.123
--- control.sml	31 May 2004 21:37:56 -0000	1.122
+++ control.sml	2 Jun 2004 17:36:43 -0000	1.123
@@ -79,6 +79,10 @@
 		       default = Native,
 		       toString = Codegen.toString}
 
+val contifyIntoMain = control {name = "contifyIntoMain",
+			       default = false,
+			       toString = Bool.toString}
+
 val deadCode = control {name = "dead code",
 			default = true,
 			toString = Bool.toString}



1.39      +3 -0      mlton/mlton/main/main.fun

Index: main.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.fun,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- main.fun	31 May 2004 21:37:57 -0000	1.38
+++ main.fun	2 Jun 2004 17:36:44 -0000	1.39
@@ -157,6 +157,9 @@
 		      | "c" => codegen := CCodegen
 		      | "native" => codegen := Native
 		      | _ => usage (concat ["invalid -codegen flag: ", s]))),
+       (Expert, "contify-into-main", " {false|true}",
+	"contify functions into main",
+	boolRef contifyIntoMain),
        (Expert, "dead-code", " {true|false}",
 	"basis library dead code elimination",
 	boolRef deadCode),



1.18      +19 -1     mlton/mlton/ssa/contify.fun

Index: contify.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/contify.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- contify.fun	20 Feb 2004 02:11:15 -0000	1.17
+++ contify.fun	2 Jun 2004 17:36:44 -0000	1.18
@@ -345,7 +345,25 @@
 	  val fm_node = getFuncNode fm
 	  (* {(Root, fm)} *)
 	  val _ = addEdge {from = Root, to = fm_node}
-
+	  (* { (Root, f) | fm calls f } *)
+	  val () =
+	     if !Control.contifyIntoMain
+		then ()
+	     else
+		case List.peek (functions, fn f =>
+				Func.equals (fm, Function.name f)) of
+		   NONE => Error.bug "no main function"
+		 | SOME f =>
+		      let
+			 val {blocks, ...} = Function.dest f
+		      in
+			 Vector.foreach
+			 (blocks, fn Block.T {transfer, ...} =>
+			  case transfer of
+			     Call {func, ...} =>
+				addEdge {from = Root, to = getFuncNode func}
+			   | _ => ())
+		      end
 	  val _
 	    = List.foreach
 	      (functions,