Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

212 lines (184 sloc) 7.358 kB
/*
* Copyright (c) 2006-2008 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 mutable static profiling_enabled = true;
public FinishUp (env : GlobalEnv) : 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)
{ }
]>;
if (profiling_enabled) {
def tc = env.Define (decl);
fields.Iter (tc.Define);
tc.Compile ();
} else {
dumper = <[ () ]>;
}
}
public Wrap (full_name : string, body : PExpr) : PExpr
{
if (!profiling_enabled) body
else {
def mangled_name = full_name.Replace ('.', '_').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) ]>;
<[
def started =
if ($start == 0) {
$start = $get_time;
$count_nonrec++;
true
} else {
$count_rec++;
false
}
try {
$body;
} finally {
when (started) {
$total += $get_time - $start;
$start = 0;
}
}
]>;
}
}
}
[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
| <[ Enabled = true ]>
| <[ Enabled = 1 ]> => profiling_enabled = true
| <[ Enabled = false ]>
| <[ Enabled = 0 ]> => profiling_enabled = false
| _ =>
Message.Error ($ "invalid option $o");
}
}
[Nemerle.MacroUsage(Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Assembly)]
macro ProfSetup (params _opts : list [PExpr])
{
when (dumper == null)
FinishUp (Nemerle.Macros.ImplicitCTX().Env);
}
[Nemerle.MacroUsage(Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Method)]
macro ProfDump (_current_type : TypeBuilder, method : MethodBuilder)
{
when (dumper == null)
FinishUp (_current_type.GlobalEnv);
def newBody = Util.locate(method.Body.Location, dumper);
method.Body = newBody;
}
[Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Method, Inherited = false, AllowMultiple = false)]
macro Profile (current_type : TypeBuilder, method : ParsedMethod)
{
def newBody = Util.locate(method.Body.Location,
Wrap (current_type.FullName + "." + method.Name, method.Body));
method.Body = newBody;
}
macro @profile (id, body)
syntax ("profile", "(", id, ")", body)
{
def id =
match (id) {
| <[ $(id : dyn) ]> => id
| _ =>
Message.Error ("the syntax is 'profile (identifier) body'");
"foobar"
}
def typer = Macros.ImplicitCTX ();
Wrap (typer.CurrentTypeBuilder.FullName + "." +
typer.CurrentMethodBuilder.Name + ":::" + id, body)
}
}
Jump to Line
Something went wrong with that request. Please try again.