1 # -----------------------------------------------------------------------------
2 # $Id: ghcprof.prl,v 1.5 2005/04/22 08:41:00 simonmar Exp $
4 # (c) The GHC Team 2000
6 # needs: DEFAULT_TMPDIR, TARGETPLATFORM, icondir, xmlparser, cgprof_dir
9 if ($ENV{'UDG_HOME'}) {
10 $udrawgraphhome = $ENV{'UDG_HOME'};
11 $udrawgraph = $udrawgraphhome . "/bin/uDrawGraph";
13 print STDERR "ghcprof: UDG_HOME environment variable not set\n";
17 $machname = ${TARGETPLATFORM};
23 # where to make tmp file names?
24 if ( $ENV{'TMPDIR'} ) {
25 $Tmp_prefix = $ENV{'TMPDIR'} . "/ghcprof";
27 $Tmp_prefix ="${DEFAULT_TMPDIR}/ghcprof";
28 $ENV{'TMPDIR'} = "${DEFAULT_TMPDIR}"; # set the env var as well
31 # Create a new temporary filename.
34 while (-e ($tempfile = "$Tmp_prefix" . "$i")) {
38 # Create a second temporary filename.
41 while (-e ($tempfile2 = "$Tmp_prefix" . "$i" . ".sh")) {
45 # Delete temp. file if script is halted.
46 sub quit_upon_signal {
47 if ($tempfile ne "" && -e $tempfile) {
48 print STDERR "Deleting $tempfile .. \n" if $Verbose;
51 if ($tempfile2 ne "" && -e $tempfile2) {
52 print STDERR "Deleting $tempfile2 .. \n" if $Verbose;
57 $SIG{'INT'} = 'quit_upon_signal';
58 $SIG{'QUIT'} = 'quit_upon_signal';
63 print STDERR "$Pgm: $msg\n";
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 open(TEMPFILE2, ">$tempfile2")
224 || tidy_up_and_die("can't create `$tempfile2'");
226 $shcmd = sprintf("%s/cgprof %s %d \"%s\" " .
227 "\"%s\" %.1f %.1f %.1f %.1f %d %d %d %d %d",
228 $cgprof_dir,$tempfile,$nprocs,$machname,$date,
229 $bsp_s,$bsp_l,$bsp_g,$hide,$Verbose,$Logo,$Colour,
230 $DeltaNormalise,$MaxNoNodes);
231 print TEMPFILE2 "#!/bin/sh\n";
232 print TEMPFILE2 "$shcmd\n";
235 chmod 0755, $tempfile2;
236 $cmd = "env UDG_ICONDIR=$icondir UDG_HOME=$udrawgraphhome " .
237 $udrawgraph . " -startappl . $tempfile2";
238 print STDERR "$Pgm: exec $cmd\n" if $Verbose;
242 sub readProfileHeader {
245 open(PROFILE,$tempfile) || tidy_up_and_die("can't open `$tempfile'");
250 if (/-prof/ && /-flibrary-level\s+(\d+)/) {
252 } elsif (/-flibrary-level\s+(\d+)/) {