## compile-statistics.pkg
#
# Support code for tracking and printing the CPU
# time used by various parts of the compile process.
# Compiled by:
#
src/lib/compiler/front/basics/basics.sublib### "We are all in the gutter, but
### some of us are looking at the stars."
###
### -- Oscar Wilde
stipulate
package at = runtime_internals::at; # runtime_internals is from
src/lib/std/src/nj/runtime-internals.pkg package cp = control_print; # control_print is from
src/lib/compiler/front/basics/print/control-print.pkg package ct = cpu_timer; # cpu_timer is from
src/lib/std/src/cpu-timer.pkg package tm = time; # time is from
src/lib/std/time.pkgherein
package compile_statistics
: Compile_Statistics # Compile_Statistics is from
src/lib/compiler/front/basics/stats/compile-statistics.api {
time_to_string
=
tm::format 2;
Counter
=
COUNTER
{ count: Ref( Int ), # Primary count associated with the counter.
secondary_counters: List( Counter ) # We also increment these whenever we increment the primary value.
};
Counterssum
=
COUNTERSSUM
{ name: String,
counters: List( Counter )
};
all_statistics = REF (NIL: List( Counterssum )); # More icky thread-hostile mutable global state. :-( XXX BUGGO FIXME
# Search by name in a list of counterssum (in practice, all_statistics),
# return NULL if not found:
#
fun find_statistic (name, NIL)
=>
NULL;
find_statistic (name, (p as COUNTERSSUM { name=>n, ... } ) ! rest)
=>
if (name == n) THE p;
else find_statistic (name, rest);
fi;
end;
# Add statistic to a list (in practice, all_statistics):
#
fun insert ( p as COUNTERSSUM { name => pn, ... },
(q as COUNTERSSUM { name => qn, ... } ) ! rest
)
=>
if (pn < qn) p ! q ! rest;
else q ! insert (p, rest);
fi;
insert (p, NIL)
=>
p ! NIL;
end;
fun make_counter secondary_counters
=
COUNTER { count => REF 0,
secondary_counters
};
fun increment_counter_by (COUNTER { count, secondary_counters }) n
=
{ count := *count + n; # Increment our primary count.
#
apply # Increment any secondary counts we were given.
(\\ count = increment_counter_by count n)
secondary_counters;
};
fun get_counter_value (COUNTER { count => REF counter_value, ... } )
=
counter_value;
fun make_counterssum (name, counters)
=
COUNTERSSUM { name, counters };
fun note_counterssum (p as COUNTERSSUM { name, counters } )
=
case (find_statistic (name, *all_statistics))
#
THE p => ();
NULL => all_statistics := insert (p, *all_statistics);
esac;
fun make_counterssum' name
=
case (find_statistic (name, *all_statistics))
#
THE p => p;
#
NULL => { p = make_counterssum (name, [ make_counter [] ]);
#
all_statistics := insert (p,*all_statistics); p;
};
esac;
fun increment_counterssum_by (COUNTERSSUM { counters => (counter ! _), ... } ) n => increment_counter_by counter n;
increment_counterssum_by (COUNTERSSUM { counters => [], ... } ) _ => ();
end;
say = cp::say;
flush = cp::flush;
# NOTE: we should be able to rewrite this using the timer package XXX BUGGO FIXME
Times = { usr: tm::Time,
sys: tm::Time,
gc: tm::Time
};
zeros = { usr => tm::zero_time,
sys => tm::zero_time,
gc => tm::zero_time
};
Compiler_Phase
=
COMPILER_PHASE
{ name: String,
cumulative: Ref( Times ),
this: Ref( Times )
};
all_compiler_phases = REF (NIL: List(Compiler_Phase)); # XXX BUGGO FIXME Another icky bit of global mutable state.
stipulate
# Search by name in all_compiler_phases, return compiler_phase else NULL:
#
fun find_compiler_phase (name, NIL)
=>
NULL;
find_compiler_phase (name, (p as COMPILER_PHASE { name=>n, ... } ) ! rest)
=>
if (name == n) THE p;
else find_compiler_phase (name, rest);
fi;
end;
# Add named compiler_phase to all_compiler_phases:
#
fun insert_compiler_phase ( p as COMPILER_PHASE { name=>pn, ... },
(q as COMPILER_PHASE { name=>qn, ... } ) ! rest
)
=>
if (pn < qn) p ! q ! rest;
else q ! insert_compiler_phase (p, rest);
fi;
insert_compiler_phase (p, NIL)
=>
p ! NIL;
end;
herein
fun make_compiler_phase name
=
case (find_compiler_phase (name, *all_compiler_phases))
#
THE p => p;
#
NULL => p
where
p = COMPILER_PHASE { name,
cumulative => REF zeros,
this => REF zeros
};
all_compiler_phases := insert_compiler_phase (p, *all_compiler_phases);
end;
esac;
end;
current = REF (make_compiler_phase "Other"); # Global mutable state. XXX BUGGO FIXME
keep_time = REF TRUE; # Global mutable state. XXX BUGGO FIXME
approx_time = REF TRUE; # Global mutable state. XXX BUGGO FIXME
#
# At the moment these three are controlled by hardwired logic in
#
src/app/makelib/compile/compile-in-dependency-order-g.pkg # -- look for show_compile_compiler_phase_runtimes_for():
#
say_begin = REF FALSE; # By default, do not narrate start of each compiler phase. # Global mutable state. XXX BUGGO FIXME
say_end = REF FALSE; # By default, do not narrate end of each compiler phase, with CPU seconds used. # Global mutable state. XXX BUGGO FIXME
# say_begin = log::debugging; # By default, do not narrate start of each compiler phase. # Global mutable state. XXX BUGGO FIXME
# say_end = log::debugging; # By default, do not narrate end of each compiler phase, with CPU seconds used. # Global mutable state. XXX BUGGO FIXME
say_when_nonzero = REF FALSE; # By default, even if previous is *TRUE, do not narrate end of compiler phases with 0.00 seconds of CPU usage. # Global mutable state. XXX BUGGO FIXME
infix my 70 +++ ; my (+++) = time::(+) ;
infix my 70 --- ; my (---) = time::(-) ;
infix my 70 ++++ ;
fun { usr, sys, gc }++++{ usr=>u, sys=>s, gc=>g }
=
{ usr => usr+++u,
sys => sys+++s,
gc => gc+++g
};
infix my 70 ---- ;
fun { usr, sys, gc }----{ usr=>u, sys=>s, gc=>g }
=
if (time::(<) (usr, u))
#
zeros;
else
{ usr => usr---u,
sys => sys---s,
gc => gc---g
};
fi;
stipulate
fun gettime ()
=
{ (ct::get_elapsed_heapcleaner_and_program_usermode_and_kernelmode_cpu_seconds (ct::get_cpu_timer ()))
->
{ program, heapcleaner };
# This is a hack.
# (This module deserves a complete rewrite!!) XXX SUCKO FIXME
{ usr => time::from_float_seconds program.usermode_cpu_seconds,
sys => time::from_float_seconds (program.kernelmode_cpu_seconds + heapcleaner.kernelmode_cpu_seconds),
gc => time::from_float_seconds heapcleaner.usermode_cpu_seconds
};
};
last = REF (gettime()); # More icky thread-hostile global mutable state. XXX SUCKO FIXME
herein
fun reset ()
=
{ last := gettime ();
apply
(\\ COMPILER_PHASE { this, cumulative, ... } = { this := zeros; cumulative := zeros; })
*all_compiler_phases;
# Zero all counts, both primary and secondary counters:
#
apply
(\\ COUNTERSSUM { counters, ... } = apply (\\ COUNTER { count, ... } = count := 0) counters)
*all_statistics;
};
my _ =
at::schedule
(
"compile-statistics.pkg: reset", # Arbitrary label
[ at::STARTUP_PHASE_8_RESET_COMPILER_STATISTICS ], # When to run the function.
\\ _ = { reset(); } # Function to run.
);
my _ =
at::schedule
(
"compile-statistics.pkg: last := zeros", # Arbitrary label
[ at::SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS ], # When to run the function.
\\ _ = { last := zeros; }
);
fun since()
=
{
# x = if *approxTime
# then let
# t1 = *lastcollect
# u1 = *System::Runtime::minorcollections
# in lastcollect := u1; u1!=t1 end
# else TRUE;
x = TRUE;
if x
t = *last;
u = gettime();
last := u;
(u ---- t);
else
zeros;
fi;
};
end; # stipulate
# Call f(x) n times: # Shouldn't this move to standard.lib somewhere?
#
fun repeat 0 f x
=>
();
repeat n f x
=>
{ f x;
repeat (n - 1) f x;
};
end;
fun sayfield (n, string) # Print 'string', pad to length 'n' with trailing blanks.
=
{ say string;
#
repeat (int::max (0, n - size(string))) say " ";
};
# Call f(x) while tracking and maybe
# printing its CPU time consumption:
#
fun do_compiler_phase (p as COMPILER_PHASE { name, this, cumulative }) f x
=
{ (*current)
->
prev as COMPILER_PHASE { this=>t', ... };
fun end_time ()
=
{ (since() ++++ *this)
->
x as { usr, sys, gc };
this := zeros;
cumulative := *cumulative ++++ x;
usr +++ sys +++ gc;
};
fun finish ()
=
{ current := prev;
#
if *say_end
#
time = time_to_string (end_time ());
#
if (time != "0.00" or *say_when_nonzero)
#
say "End ";
sayfield (40, name);
if *keep_time apply say [" ", time, " sec\n"];
else say "\n";
fi;
flush();
fi;
else
end_time();
();
fi;
};
if *keep_time
#
t' := since() ++++ *t';
fi;
current := p;
if *say_begin
#
apply say ["Begin ", name, "\n"];
flush();
fi;
( (f x)
except
e = { finish ();
raise exception e;
}
)
then
finish ();
};
fun compute_sum_of_counters (COUNTERSSUM { counters, ... } ) # Sum primary values of our counters.
=
fold_forward
(\\ (counter, sum) = get_counter_value counter + sum)
0
counters;
fun show_statistic (s as COUNTERSSUM { name, counters } )
=
{ sayfield (40, name);
say (int::to_string (compute_sum_of_counters s));
say "\n";
};
fun show_compiler_phase (COMPILER_PHASE { name, this, cumulative } )
=
{ (*this ++++ *cumulative)
->
{ usr, sys, gc };
sayfield (40, name);
say (time_to_string usr); say "u ";
say (time_to_string sys); say "s ";
say (time_to_string gc ); say "g ";
say "\n";
};
fun summary ()
=
{ sum = fold_backward
(\\ (COMPILER_PHASE { cumulative, ... }, t) = *cumulative ++++ t)
zeros
*all_compiler_phases;
apply show_statistic *all_statistics;
apply
show_compiler_phase
(*all_compiler_phases @ [COMPILER_PHASE { name=>"TOTAL", this=>REF zeros, cumulative=>REF sum } ]);
};
fun show_compiler_phase_sp (COMPILER_PHASE { name, this, cumulative } )
=
{ (*this ++++ *cumulative)
->
{ usr, sys, gc };
case (tm::compare (usr+++sys+++gc, tm::zero_time))
#
EQUAL => ();
#
_ => { sayfield (40, name);
say (time_to_string (usr+++sys)); say "u ";
# say (time_to_string sys); say "s ";
say (time_to_string gc); say "g ";
say "\n";
};
esac;
};
fun summary_sp () # Apparently never called. No clue what "sp" means.
=
{ sum = fold_backward
(\\ (COMPILER_PHASE { cumulative, ... }, t) = *cumulative++++t)
zeros
*all_compiler_phases;
apply show_statistic *all_statistics;
apply show_compiler_phase_sp
( *all_compiler_phases
@
[ COMPILER_PHASE { name => "TOTAL",
this => REF zeros,
cumulative => REF sum
}
]
);
};
}; # package compile_statistics
end;