[svn] r6050: nemerle/trunk: macros/Profiling.n ncc/Makefile

malekith svnadmin at nemerle.org
Fri Jan 6 21:03:15 CET 2006


Log:
New profiling macros.

Author: malekith
Date: Fri Jan  6 21:03:10 2006
New Revision: 6050

Added:
   nemerle/trunk/macros/Profiling.n
Modified:
   nemerle/trunk/ncc/Makefile

Added: nemerle/trunk/macros/Profiling.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/macros/Profiling.n	Fri Jan  6 21:03:10 2006
@@ -0,0 +1,179 @@
+/*
+ * Copyright (c) 2006 The University of Wroclaw.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *    1. Redistributions of source code must retain the above copyright
+ *       notice, this list of conditions and the following disclaimer.
+ *    2. Redistributions in binary form must reproduce the above copyright
+ *       notice, this list of conditions and the following disclaimer in the
+ *       documentation and/or other materials provided with the distribution.
+ *    3. The name of the University may not be used to endorse or promote
+ *       products derived from this software without specific prior
+ *       written permission.
+ * 
+ * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+ * NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+ * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+using Nemerle.Collections;
+using Nemerle.Compiler;
+using Nemerle.Compiler.Parsetree;
+
+using Nemerle.Profiling.Helper;
+
+namespace Nemerle.Profiling
+{
+  internal module Helper
+  {
+    public mutable static get_time : PExpr = <[ System.Environment.TickCount ]>;
+    public mutable static time_type : PExpr = <[ int ]>;
+    public mutable static divisor : PExpr = <[ 1 ]>;
+    public mutable static field_names : list [string * string] = [];
+    public mutable static class_name : Name = null;
+    public mutable static dumper : PExpr = null;
+
+    public FinishUp () : void
+    {
+      mutable fields = [];
+
+      mutable b1 = [];
+      mutable b2 = [];
+
+      foreach ((full, mangled_name) in field_names) {
+        fields ::= <[ decl:
+          internal static mutable $(mangled_name + "_start" : dyn) : $time_type
+        ]>;
+        fields ::= <[ decl:
+          internal static mutable $(mangled_name + "_total" : dyn) : $time_type
+        ]>;
+        fields ::= <[ decl:
+          internal static mutable $(mangled_name + "_count_rec" : dyn) : long
+        ]>;
+        fields ::= <[ decl:
+          internal static mutable $(mangled_name + "_count_nonrec" : dyn) : long
+        ]>;
+
+        def total = <[ $(class_name : name).$(mangled_name + "_total" : dyn) ]>;
+        def count_rec = <[ $(class_name : name).$(mangled_name + "_count_rec" : dyn) ]>;
+        def count_nonrec = <[ $(class_name : name).$(mangled_name + "_count_nonrec" : dyn) ]>;
+
+        b1 ::=
+          <[ when ($total > max) max = $total; ]>;
+
+        b2 ::= 
+          <[ 
+          System.Console.WriteLine ("{0,7:0.00}% {1,8} {2,8}-{3,-8} {4,8:0.00}({5,-8:0.00}) {6}",
+                          $total * 100.0 / max,
+                          $total / $divisor,
+                          $count_rec + $count_nonrec,
+                          $count_rec,
+                          1.0 * $total / $divisor / ($count_rec + $count_nonrec),
+                          1.0 * $total / $divisor / ($count_nonrec),
+                          $(full : string))
+          ]>;
+      }
+
+      dumper =
+        <[
+          mutable max : $time_type = 1;
+          System.Console.WriteLine ("{0,8} {1,8} {2,8}-{3,-8} {4,8}({5,-8}) {6}",
+                                      "%total", "cycles", "calls", "recurs.",
+                                      "cyc/call", "w/o rec", "function name");
+          {.. $(b1 + b2) }
+        ]>;
+
+      field_names = null;
+
+      def decl = <[ decl:
+        internal class $(class_name : name)
+        { }
+      ]>;
+      def tc = GlobalEnv.Core.Define (decl);
+      fields.Iter (tc.Define);
+      tc.Compile ();
+    }
+  }
+  
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance,
+                       Nemerle.MacroTargets.Assembly)]
+  macro ProfSetup (params opts : list [PExpr])
+  {
+    class_name = Macros.NewSymbol ("Profiler");
+    foreach (o in opts) {
+      | <[ GetTime = $expr ]> => get_time = expr
+      | <[ TimeType = $expr ]> => time_type = expr
+      | <[ Divisor = $expr ]> => divisor = expr
+      | _ =>
+        Message.Error ($ "invalid option $o");
+    }
+  }
+  
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers,
+                       Nemerle.MacroTargets.Assembly)]
+  macro ProfSetup (params _opts : list [PExpr])
+  {
+    when (dumper == null)
+      FinishUp ();
+  }
+  
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers,
+                       Nemerle.MacroTargets.Method)]
+  macro ProfDump (_current_type : TypeBuilder, method : MethodBuilder)
+  {
+    when (dumper == null)
+      FinishUp ();
+    method.Body = dumper;
+  }
+  
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance,
+                       Nemerle.MacroTargets.Method,
+                       Inherited = false, AllowMultiple = false)]
+  macro Profile (current_type : TypeBuilder, method : ParsedMethod)
+  {
+    def full_name = current_type.FullName + "." + method.Name;
+    def mangled_name = full_name.Replace ('.', '_');
+
+    assert (field_names != null);
+    assert (class_name != null);
+
+    field_names ::= (full_name, mangled_name);
+    
+    def start = <[ $(class_name : name).$(mangled_name + "_start" : dyn) ]>;
+    def total = <[ $(class_name : name).$(mangled_name + "_total" : dyn) ]>;
+    def count_rec = <[ $(class_name : name).$(mangled_name + "_count_rec" : dyn) ]>;
+    def count_nonrec = <[ $(class_name : name).$(mangled_name + "_count_nonrec" : dyn) ]>;
+    
+    method.Body = <[
+      def started =
+        if ($start == 0) {
+          $start = $get_time;
+          $count_nonrec++;
+          true
+        } else {
+          $count_rec++;
+          false
+        }
+      try {
+        $(method.Body);
+      } finally {
+        when (started) {
+          $total += $get_time - $start;
+          $start = 0;
+        }
+      }
+    ]>;
+  }
+  
+}

Modified: nemerle/trunk/ncc/Makefile
==============================================================================
--- nemerle/trunk/ncc/Makefile	(original)
+++ nemerle/trunk/ncc/Makefile	Fri Jan  6 21:03:10 2006
@@ -144,6 +144,7 @@
 NCC_EXE_SRC       = main.n
 
 STDMACROS_DLL_SRC = \
+	../macros/Profiling.n \
 	../macros/xml.n \
         ../macros/text.n \
         ../macros/io.n \



More information about the svn mailing list