1 # -----------------------------------------------------------------------------
2 # $Id: ghcprof.prl,v 1.4 2000/09/05 10:16:41 simonmar Exp $
4 # (c) The GHC Team 2000
6 # needs: FPTOOLS_TOP_ABS, INSTALLING, DEFAULT_TMPDIR, TARGETPLATFORM, libdir, libexecdir
9 if ($ENV{'DAVINCIHOME'}) {
10 $davincihome = $ENV{'DAVINCIHOME'};
11 $davinci = $davincihome . "/daVinci";
13 print STDERR "ghcprof: DAVINCIHOME environment variable not set";
17 $machname = ${TARGETPLATFORM};
23 $icondir = ( $INSTALLING ? "$libdir/icons"
24 : "$FPTOOLS_TOP_ABS/ghc/utils/prof/icons" );
26 $xmlparser = ( $INSTALLING ? "$libexecdir/xmlparser"
27 : "$FPTOOLS_TOP_ABS/ghc/utils/prof/xmlparser/xmlparser" );
29 $cgprof_dir = ( $INSTALLING ? "$libexecdir"
30 : "$FPTOOLS_TOP_ABS/ghc/utils/prof/cgprof" );
32 # where to make tmp file names?
33 if ( $ENV{'TMPDIR'} ) {
34 $Tmp_prefix = $ENV{'TMPDIR'} . "/ghcprof";
36 $Tmp_prefix ="${DEFAULT_TMPDIR}/ghcprof";
37 $ENV{'TMPDIR'} = "${DEFAULT_TMPDIR}"; # set the env var as well
40 # Create an new temporary filename.
43 while (-e ($tempfile = "$Tmp_prefix" . "$i")) {
47 # Delete temp. file if script is halted.
48 sub quit_upon_signal {
49 if ($tempfile ne "") {
50 print STDERR "Deleting $tempfile .. \n";
54 $SIG{'INT'} = 'quit_upon_signal';
55 $SIG{'QUIT'} = 'quit_upon_signal';
60 print STDERR "$Pgm: $msg\n";
61 if ($tempfile ne "" && -e $tempfile) {
62 print STDERR "Deleting $tempfile .. \n" if $Verbose;
68 select(STDERR); $| = 1; select(STDOUT); # no STDERR buffering, please.
69 ($Pgm = $0) =~ s|.*/||;
70 $Version = "v2.1 10-3-2000";
71 $bug_reports_to = 'stephen.jarvis@dcs.warwick.ac.uk';
73 $ShortUsage = "\n$Pgm usage: for basic information, try the `-help' option\n";
76 Usage: $Pgm [option...] filename.prof
83 -color Enable color (default)
97 arg: while ($_ = $ARGV[0]) {
99 #--------HELP------------------------------------------------
100 /^-help$/ && do { print STDERR $Usage; exit(0); };
102 /^-v$/ && do {$Verbose = 1; next arg;};
104 /^-hide$/ && do {$hide= &grab_next_arg("-hide");
105 if (($hide =~ /^(\d+.\d+)$/) || ($hide =~ /^(\d+)$/)) {
108 print STDERR "$Pgm: -hide requires a percentage as ",
114 /^-nologo$/ && do {$Logo =0; next arg;};
115 /^-gr(e|a)y$/ && do {$Colour=0; next arg;};
116 /^-colou?r$/ && do {$Colour=1; next arg;};
117 /^-normalise$/ && do {$DeltaNormalise = &grab_next_arg("-normalise");
118 if ($DeltaNormalise =~ /^(\d+)$/) {
119 $DeltaNormalise = int($DeltaNormalise);
121 print STDERR "$Pgm: -normalise requires an integer ",
127 /^-/ && do { print STDERR "$Pgm: unrecognised option \"",$_,"\"\n";
131 if ($InputFile eq "") {
132 $InputFile = $_; next arg;
138 if ($InputFile eq "") {
139 print STDERR "$Pgm: no input file given\n";
143 print STDERR $ShortUsage;
146 print STDERR "$Pgm: ($Version)\n" if $Verbose;
148 # -----------------------------------------------------------------------------
151 # ToDo: use the real xmlparser
152 # system("$xmlparser < $InputFile > $tempfile");
153 # if ($? != 0) { tidy_up_and_die("xmlparser failed"); }
155 # Stehpen's hacky replacement for xmlparser:
161 open(INPUT, "<$InputFile") || tidy_up_and_die("can't open `$InputFile'");
162 open(TEMPFILE, ">$tempfile") || tidy_up_and_die("can't create `$tempfile'");
165 if (/^1 (\d+) (.*)$/)
168 print TEMPFILE ">>cost_centre\n";
174 print TEMPFILE "$cc_id $name $module\n";
176 if (/^2 (\d+) (\d+) (\d+)$/)
179 print TEMPFILE ">>cost_centre_stack\n";
185 print TEMPFILE "$ccs_id $ccptr $ccsptr\n";
187 elsif (/^2 (\d+) (\d+) (\d+) (\d+)$/)
190 print TEMPFILE ">>cost_centre_stack\n";
197 print TEMPFILE "$ccs_id $type $ccptr $ccsptr\n";
199 if (/^5 (\d+) (.*)$/)
202 print TEMPFILE ">>scc_sample\n";
206 while (/^1 (\d+) (\d+) (\d+) (\d+) (.*)$/)
212 print TEMPFILE "$rg1 $rg2 $rg3 $rg4\n";
217 print TEMPFILE ">>\n";
222 &readProfileHeader();
223 $cmd = sprintf("%s -startappl %s 'cgprof %s %d \"%s\" ".
224 "\"%s\" %.1f %.1f %.1f %.1f %d %d %d %d %d'",
225 $davinci,$cgprof_dir,$tempfile,$nprocs,$machname,$date,
226 $bsp_s,$bsp_l,$bsp_g,$hide,$Verbose,$Logo,$Colour,
227 $DeltaNormalise,$MaxNoNodes);
228 $cmd = "env DAVINCI_ICONDIR=$icondir TCL_LIBRARY=$davincihome/lib/tcl ".
229 "TK_LIBRARY=$davincihome/lib/tk DAVINCIHOME=$davincihome " . $cmd;
230 print STDERR "$Pgm: exec $cmd\n" if $Verbose;
234 sub readProfileHeader {
237 open(PROFILE,$tempfile) || tidy_up_and_die("can't open `$tempfile'");
242 if (/-prof/ && /-flibrary-level\s+(\d+)/) {
244 } elsif (/-flibrary-level\s+(\d+)/) {