Message-Id: <199605092027.QAA16842@verdandi.cs.cornell.edu>
To: caml-list@pauillac.inria.fr
Subject: another time-based profiler
Date: Thu, 09 May 1996 16:27:30 -0400
From: Mark Hayden <hayden@cs.cornell.edu>
...this time for Objective Caml
It difficult to keep up with the Caml
implementors. I posted a profiler yesterday,
and then a new version of the language comes out
today. Here is a version for Objective Caml.
The main difference is that Objective Caml
provides stubs to the Unix setitimer() system
call and access to the profiling interrupt
signals, so those are once again supported.
A README file is included below, followed by
a shar file.
--Mark Hayden
A time-based profiler for Objective Caml
Author: Mark Hayden, 4/96, hayden@cs.cornell.edu
This library is a simple time-based profiling package (as opposed to the
call-count profiler included with Objective Caml). It is intended to be
similar in design and output to the time-based parts of the gprof package
for C. This library only works with Unix because it requires Unix timer
signals.
This libary is very similar to the time-profiler announced by Christophe
Raffalli. It differs in that it uses signals to avoid making calls to
Unix.times on every call to a profiled function. So potentially this
library does not affect application performance as much. Also, after
initialization, this profiler is designed to (I believe) not cause any
additional memory allocation.
Functions are registered with the profiler through calls to [Profile.fN
"function" function], where N is the number of arguments to the function,
from 1 to 3. The first argument is a string name of the function and the
second argument is the function itself. Returned is a wrapped version of
the function. For example, if 'f' is a one argument function:
let f arg = .... ;;
let f = Profile.f1 "f" f ;;
The profiler is started with a call to [Profile.start()] and is ended with
a call to [Profile.stop()]. The call to end causes profiling information
to be dumped to stdout. The output is similar to the gprof package for C:
refer to that documentation for a description.
The source file profile.ml contains an embedded test program, "testprof",
which is compiled by the included Makefile. The test program is given
below along with example output.
(**************************************************************)
(* Sample test program. *)
let test () =
let f () = for i = 1 to 1000 do () done in
let f = f1 "f" f in
let g () = for i = 1 to 100 do () done in
let g = f1 "g" g in
let h () = for i = 1 to 1000 do f () ; g () done in
let h = f1 "h" h in
start () ;
h () ;
stop ()
(* Sample output:
Number of samples is 128
Each sample counts as 0.01 seconds.
% self self& self total
time seconds childen calls ms/call ms/call name
92.19 1.183 1.183 1000 0.001 0.001 f
6.25 0.080 0.080 1000 0.000 0.000 g
1.56 0.020 1.283 1 0.020 1.283 h
*)
(**************************************************************)
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# README
# Makefile
# profile.ml
# profile.mli
# This archive created: Thu May 9 16:24:40 1996
export PATH; PATH=/bin:$PATH
if test -f 'README'
then
echo shar: will not over-write existing file "'README'"
else
cat << \SHAR_EOF > 'README'
A time-based profiler for Objective Caml
Author: Mark Hayden, 4/96, hayden@cs.cornell.edu
This library is a simple time-based profiling package (as opposed to the
call-count profiler included with Objective Caml). It is intended to be
similar in design and output to the time-based parts of the gprof package
for C. This library only works with Unix because it requires Unix timer
signals.
This libary is very similar to the time-profiler announced by Christophe
Raffalli. It differs in that it uses signals to avoid making calls to
Unix.times on every call to a profiled function. So potentially this
library does not affect application performance as much. Also, after
initialization, this profiler is designed to (I believe) not cause any
additional memory allocation.
Functions are registered with the profiler through calls to [Profile.fN
"function" function], where N is the number of arguments to the function,
from 1 to 3. The first argument is a string name of the function and the
second argument is the function itself. Returned is a wrapped version of
the function. For example, if 'f' is a one argument function:
let f arg = .... ;;
let f = Profile.f1 "f" f ;;
The profiler is started with a call to [Profile.start()] and is ended with
a call to [Profile.stop()]. The call to end causes profiling information
to be dumped to stdout. The output is similar to the gprof package for C:
refer to that documentation for a description.
The source file profile.ml contains an embedded test program, "testprof",
which is compiled by the included Makefile. The test program is given
below along with example output.
(**************************************************************)
(* Sample test program. *)
let test () =
let f () = for i = 1 to 1000 do () done in
let f = f1 "f" f in
let g () = for i = 1 to 100 do () done in
let g = f1 "g" g in
let h () = for i = 1 to 1000 do f () ; g () done in
let h = f1 "h" h in
start () ;
h () ;
stop ()
(* Sample output:
Number of samples is 128
Each sample counts as 0.01 seconds.
% self self& self total
time seconds childen calls ms/call ms/call name
92.19 1.183 1.183 1000 0.001 0.001 f
6.25 0.080 0.080 1000 0.000 0.000 g
1.56 0.020 1.283 1 0.020 1.283 h
*)
(**************************************************************)
SHAR_EOF
fi # end of overwriting check
if test -f 'Makefile'
then
echo shar: will not over-write existing file "'Makefile'"
else
cat << \SHAR_EOF > 'Makefile'
#*************************************************************#
# Author: Mark Hayden, 4/96
#*************************************************************#
CSLCOMP = ocamlc
CSLFLAGS = -c
#*************************************************************#
.SUFFIXES :
.SUFFIXES : .ml .mli .cmi .cmo .o .c
.mli.cmi:
$(CSLCOMP) $(CSLFLAGS) $<
.ml.cmo:
$(CSLCOMP) $(CSLFLAGS) $<
#*************************************************************#
testprof: profile.cmo
ocamlc -custom -o testprof unix.cma profile.cmo -cclib -lunix
profile.cmo: profile.cmi
#*************************************************************#
shar:
shar README Makefile profile.ml profile.mli >profile.shar
get:
cp -f /usr/u/hayden/hml/udp/profile.mli .
grep -v Trace /usr/u/hayden/hml/udp/profile.ml >profile.ml
clean:
$(RM) *~ *.cm[io] *.o
#*************************************************************#
SHAR_EOF
fi # end of overwriting check
if test -f 'profile.ml'
then
echo shar: will not over-write existing file "'profile.ml'"
else
cat << \SHAR_EOF > 'profile.ml'
(**************************************************************)
(* PROFILE.ML *)
(* Author: Mark Hayden, 4/96 *)
(**************************************************************)
open Printf
open Unix
let stdout = Pervasives.stdout
(**************************************************************)
let name = "PROFILE"
let failwith s = failwith (name^":"^s)
(**************************************************************)
(* BUGS:
* fixed stack size
* CSL Sys module does not support profiling signals, so we
use alarm signals.
*)
(**************************************************************)
let stack_size = 1000 (* some big # *)
(**************************************************************)
type prof_info = {
name : string ;
mutable live : bool ;
mutable self_ctr : int ;
mutable total_ctr : int ;
mutable ncalls : int
}
(**************************************************************)
let stack = Array.create stack_size
{name="";live=false;self_ctr=0;total_ctr=0;ncalls=0}
let sp = ref 0
let ticks = ref 0
let funcs = ref []
(**************************************************************)
let alloc_info name =
let info = {
name = name ;
live = false ;
self_ctr = 0 ;
total_ctr = 0 ;
ncalls = 0
} in
funcs := info :: !funcs ;
info
(**************************************************************)
let handler _ =
incr ticks ;
let top = pred !sp in
if top >= 0 then
stack.(top).self_ctr <-
succ stack.(top).self_ctr ;
for i = 0 to top do
stack.(i).total_ctr <-
succ stack.(i).total_ctr
done
(**************************************************************)
let start_time = ref None
and end_time = ref None
and started = ref false
let start () =
if !started then
failwith "profiler started more than once" ;
started := true ;
start_time := Some (times()) ;
Sys.signal Sys.sigprof (Sys.Signal_handle handler) ;
setitimer ITIMER_PROF {it_interval=0.001 ; it_value=0.001} ;
()
let stop () =
if not !started then
failwith "profile:stop:profiler not started" ;
started := false ;
end_time := Some (times()) ;
setitimer ITIMER_PROF {it_interval=0.0 ; it_value=0.0} ;
Sys.signal Sys.sigprof (Sys.Signal_default) ;
let cmp i1 i2 = i1.self_ctr > i2.self_ctr in
match !start_time, !end_time with
| Some{tms_utime=start_user}, Some{tms_utime=end_user}-> (
let foi = float in
let time = end_user -. start_user in
let sample = time /. foi !ticks in
printf " Number of samples is %d\n" !ticks ;
printf " Each sample counts as %.2f seconds.\n\n" sample ;
printf " %% self self& self total\n" ;
printf " time seconds childen calls ms/call ms/call name\n" ;
List.iter (fun info ->
printf "%5.2f %8.3f %8.3f %8d %7.3f %7.3f %s\n"
(foi info.self_ctr /. foi !ticks *. 100.0)
(foi info.self_ctr *. sample)
(foi info.total_ctr *. sample)
(info.ncalls)
(foi info.self_ctr *. sample /. foi info.ncalls)
(foi info.total_ctr *. sample /. foi info.ncalls)
(info.name)
) (Sort.list cmp !funcs) ;
printf "\n" ; flush stdout
)
| _ -> failwith "sanity"
(**************************************************************)
let f1 name f =
let info = alloc_info name in
fun a1 ->
info.ncalls <- succ info.ncalls ;
if info.live then (
f a1
) else (
stack.(!sp) <- info ;
info.live <- true ;
incr sp ;
let res = try f a1 with x -> (
decr sp ;
info.live <- false ;
raise x
) in
decr sp ;
info.live <- false ;
res
)
(* copied from f1 *)
let f2 name f =
let info = alloc_info name in
fun a1 a2 ->
info.ncalls <- succ info.ncalls ;
if info.live then (
f a1 a2
) else (
stack.(!sp) <- info ;
info.live <- true ;
incr sp ;
let res = try f a1 a2 with x -> (
decr sp ;
info.live <- false ;
raise x
) in
decr sp ;
info.live <- false ;
res
)
(* copied from f1 *)
let f3 name f =
let info = alloc_info name in
fun a1 a2 a3 ->
info.ncalls <- succ info.ncalls ;
if info.live then (
f a1 a2 a3
) else (
stack.(!sp) <- info ;
info.live <- true ;
incr sp ;
let res = try f a1 a2 a3 with x -> (
decr sp ;
info.live <- false ;
raise x
) in
decr sp ;
info.live <- false ;
res
)
(**************************************************************)
(**************************************************************)
(* Sample test program. *)
let test () =
let f () = for i = 1 to 1000 do () done in
let f = f1 "f" f in
let g () = for i = 1 to 100 do () done in
let g = f1 "g" g in
let h () = for i = 1 to 1000 do f () ; g () done in
let h = f1 "h" h in
start () ;
h () ;
stop ()
(* Sample output:
Number of samples is 128
Each sample counts as 0.01 seconds.
% self self& self total
time seconds childen calls ms/call ms/call name
92.19 1.183 1.183 1000 0.001 0.001 f
6.25 0.080 0.080 1000 0.000 0.000 g
1.56 0.020 1.283 1 0.020 1.283 h
*)
(**************************************************************)
let _ =
let nm = Filename.basename Sys.argv.(0) in
if nm = "testprof" then (
Printexc.catch test () ;
exit 0
)
(**************************************************************)
SHAR_EOF
fi # end of overwriting check
if test -f 'profile.mli'
then
echo shar: will not over-write existing file "'profile.mli'"
else
cat << \SHAR_EOF > 'profile.mli'
(**************************************************************)
(* PROFILE.MLI *)
(* Author: Mark Hayden, 4/96 *)
(**************************************************************)
val start : unit -> unit
val stop : unit -> unit
val f1 : string -> ('a -> 'b) -> ('a -> 'b)
val f2 : string -> ('a -> 'b -> 'c) -> ('a -> 'b -> 'c)
val f3 : string -> ('a -> 'b -> 'c -> 'd) -> ('a -> 'b -> 'c -> 'd)
(**************************************************************)
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0