github.com/wfjm.w11
1
0
Fork 0
mirror of https://github.com/wfjm/w11.git synced 2026-01-26 20:32:10 +00:00
Code Issues Releases Wiki Activity
Files
fefa952a4dcd50ce4b2d68adc6dabdacdaf9ec00
wfjm.w11/tools/bin/dmscntanal
wfjm a73bda34de perl scripts: add and use bailout
2018-12-24 09:02:41 +01:00

492 lines
13 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl -w
# $Id: dmscntanal 1089 2018-12-19 10:45:41Z mueller $
#
# Copyright 2015-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
#
# This program is free software; you may redistribute and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation, either version 3, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for complete details.
#
# Revision History:
# Date Rev Version Comment
# 2018-12-18 1089 1.0.1 add and use bailout
# 2015-06-28 696 1.0 Initial version
#
use 5.14.0; # require Perl 5.14 or higher
use strict; # require strict checking
use Getopt::Long;
my %opts = ();
GetOptions(\%opts, "help", "raw")
or bailout("bad command options");
my @snum2nam;
my %snam2num;
my %dat_all;
my %dat_km;
my %dat_um;
my $sum_all;
my $sum_km;
my $sum_um;
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
if (exists $opts{help}) {
print_help();
exit 0;
}
foreach my $file (@ARGV) {
read_file($file);
add_groups();
show_raw() if exists $opts{raw};
show_frac();
}
#-------------------------------------------------------------------------------
sub read_file {
my ($file) = @_;
%dat_km = ();
%dat_um = ();
%dat_all = ();
@snum2nam = ();
%snam2num = ();
$sum_all = 0;
$sum_km = 0;
$sum_um = 0;
open IFILE,"<$file" or bailout("failed to open '$file': $!");
while (<IFILE>) {
chomp;
next if m/^#/;
if (m/^\s*([[:xdigit:]]+)
\s+(\w+)
\s+(\d+)
\s+(\d+)
\s+(\d+)/x) {
my $snum = hex($1);
my $snam = $2;
my $all = 1. * "$3.";
my $km = 1. * "$4.";
my $um = 1. * "$5.";
$snum2nam[$snum] = $snam;
$snam2num{$snam} = $snum;
$dat_all{$snam} += $all;
$dat_km{$snam} += $km;
$dat_um{$snam} += $um;
$sum_all += $all;
$sum_km += $km;
$sum_um += $um;
} else {
printf STDERR "bad line: $_\n";
}
}
close IFILE;
}
#-------------------------------------------------------------------------------
sub show_raw {
print "#\n";
print "#sn state all km usm" .
" all% km% usm%\n";
printf "# sum_all %11.0f %11.0f %11.0f %6.2f %6.2f %6.2f\n",
$sum_all, $sum_km, $sum_um,
get_frac(100., $sum_all, $sum_all),
get_frac(100., $sum_km, $sum_all),
get_frac(100., $sum_um, $sum_all);
for (my $snum=0; $snum<scalar(@snum2nam); $snum++) {
my $snam = $snum2nam[$snum];
next unless defined $snam;
printf "%3.3x %-18s %11.0f %11.0f %11.0f %6.2f %6.2f %6.2f\n",
$snum, $snam, $dat_all{$snam}, $dat_km{$snam}, $dat_um{$snam},
get_frac(100., $dat_all{$snam}, $sum_all),
get_frac(100., $dat_km{$snam}, $sum_km),
get_frac(100., $dat_um{$snam}, $sum_um);
}
}
#-------------------------------------------------------------------------------
sub show_frac {
print "#\n";
print "# Ratio all km usm\n";
print_frac('%','cycles busy', 'g_sum_exec', 'g_sum');
print_frac('%','cycles cpmem', 'g_cp_mem', 'g_sum');
print_frac('%','cycles wextra', 'g_all_wextra', 'g_sum_exec');
print_frac('%','cycles jsr+rts', 'g_op_jsrrts', 'g_sum_exec');
print_frac('%','cycles int+rti', 'g_intrti', 'g_sum_exec');
print_frac('%','ifetch/idecode', 's_ifetch', 's_idecode');
print_frac('%','flow cntl/idecode', 'g_flow', 's_idecode');
print_frac('%',' br/idecode', 's_op_br', 's_idecode');
print_frac('%',' sob/idecode', 's_op_sob', 's_idecode');
print_frac('%',' jmp/idecode', 's_opa_jmp', 's_idecode');
print_frac('%',' jsr/idecode', 's_opa_jsr', 's_idecode');
print_frac('%',' rts/idecode', 's_op_rts', 's_idecode');
print_frac(' ','cycles/idecode (cpi)', 'g_sum_exec', 's_idecode');
print_frac(' ',' fetdec/idecode', 'g_ifetdec', 's_idecode');
print_frac(' ',' srcr/idecode', 'g_srcr', 's_idecode');
print_frac(' ',' dstr/idecode', 'g_dstr', 's_idecode');
print_frac(' ',' dstw/idecode', 'g_dstw', 's_idecode');
print_frac(' ',' dsta/idecode', 'g_dsta', 's_idecode');
print_frac(' ','ifetch_w/ifetch', 's_ifetch_w', 's_ifetch');
print_frac(' ','wextra/idecode', 'g_all_wextra', 's_idecode');
}
#-------------------------------------------------------------------------------
sub print_frac {
my ($pre,$text,$nom,$denom) = @_;
bailout("print_frac: bad key '$nom'") unless defined $snam2num{$nom};
bailout("print_frac: bad key '$denom'") unless defined $snam2num{$denom};
my $fact = ($pre eq '%') ? 100. : 1.;
printf " %-22s %7.2f%s %7.2f%s %7.2f%s\n",
$text,
get_frac($fact, $dat_all{$nom}, $dat_all{$denom}), $pre,
get_frac($fact, $dat_km{$nom}, $dat_km{$denom}), $pre,
get_frac($fact, $dat_um{$nom}, $dat_um{$denom}), $pre;
}
#-------------------------------------------------------------------------------
sub get_frac {
my ($fact,$nom,$denom) = @_;
$denom = 1. unless $denom > 0.;
return $fact*($nom/$denom);
}
#-------------------------------------------------------------------------------
sub add_groups {
group_new(0x100, 'g_sum');
$dat_all{g_sum} = $sum_all;
$dat_km{g_sum} = $sum_km;
$dat_um{g_sum} = $sum_um;
group_new(0x110, 'g_cp',
's_cp_regread',
's_cp_rps',
's_cp_memr_w',
's_cp_memw_w');
group_new(0x111, 'g_cp_mem',
's_idle',
's_cp_memr_w',
's_cp_memw_w',
'-',
's_int_ext');
group_new(0x112, 'g_ifetdec',
's_ifetch',
's_ifetch_w',
's_idecode');
group_new(0x113, 'g_srcr',
's_srcr_def',
's_srcr_def_w',
's_srcr_inc',
's_srcr_inc_w',
's_srcr_dec',
's_srcr_dec1',
's_srcr_ind',
's_srcr_ind1_w',
's_srcr_ind2',
's_srcr_ind2_w');
group_new(0x114, 'g_dstr',
's_dstr_def',
's_dstr_def_w',
's_dstr_inc',
's_dstr_inc_w',
's_dstr_dec',
's_dstr_dec1',
's_dstr_ind',
's_dstr_ind1_w',
's_dstr_ind2',
's_dstr_ind2_w');
group_new(0x115, 'g_dstw',
's_dstw_def',
's_dstw_def_w',
's_dstw_inc',
's_dstw_inc_w',
's_dstw_incdef_w',
's_dstw_dec',
's_dstw_dec1',
's_dstw_ind',
's_dstw_ind_w',
's_dstw_def246');
group_new(0x116, 'g_dsta',
's_dsta_inc',
's_dsta_incdef_w',
's_dsta_dec',
's_dsta_dec1',
's_dsta_ind',
's_dsta_ind_w');
group_new(0x120, 'g_op_rts',
's_op_rts',
's_op_rts_pop',
's_op_rts_pop_w');
group_new(0x121, 'g_op_sob',
's_op_sob',
's_op_sob1');
group_new(0x122, 'g_op_gen',
's_opg_gen',
's_opg_gen_rmw_w');
group_new(0x123, 'g_op_mul',
's_opg_mul',
's_opg_mul1');
group_new(0x124, 'g_op_div',
's_opg_div',
's_opg_div_cn',
's_opg_div_cr',
's_opg_div_sq',
's_opg_div_sr',
's_opg_div_quit');
group_new(0x125, 'g_op_ash',
's_opg_ash',
's_opg_ash_cn');
group_new(0x126, 'g_op_ashc',
's_opg_ashc',
's_opg_ashc_cn',
's_opg_ashc_wl');
group_new(0x127, 'g_op_jsr',
's_opa_jsr',
's_opa_jsr1',
's_opa_jsr_push',
's_opa_jsr_push_w',
's_opa_jsr2');
group_new(0x128, 'g_op_mtp',
's_opa_mtp',
's_opa_mtp_pop_w',
's_opa_mtp_reg',
's_opa_mtp_mem',
's_opa_mtp_mem_w');
group_new(0x129, 'g_op_mfp',
's_opa_mfp_reg',
's_opa_mfp_mem',
's_opa_mfp_mem_w',
's_opa_mfp_dec',
's_opa_mfp_push',
's_opa_mfp_push_w');
group_new(0x12a, 'g_int',
's_int_ext',
's_int_getpc',
's_int_getpc_w',
's_int_getps',
's_int_getps_w',
's_int_getsp',
's_int_decsp',
's_int_pushps',
's_int_pushps_w',
's_int_pushpc',
's_int_pushpc_w');
group_new(0x12b, 'g_rti',
's_rti_getpc',
's_rti_getpc_w',
's_rti_getps',
's_rti_getps_w',
's_rti_newpc');
group_new(0x130, 'g_op_jsrrts',
'g_op_jsr',
'g_op_rts');
group_new(0x131, 'g_flow',
's_op_br',
's_op_sob',
's_opa_jmp',
's_opa_jsr',
's_op_rts');
group_new(0x13a, 'g_intrti',
'g_int',
'g_rti');
group_new(0x101, 'g_sum_noidle',
'g_sum',
'-',
'g_cp_mem',
's_op_wait');
group_new(0x102, 'g_sum_exec',
'g_sum_noidle',
'-',
'g_int',
'g_rti');
group_new(0x140, 'g_ifetch_wextra',
's_ifetch_w',
'-',
's_ifetch');
group_new(0x141, 'g_srcr_wextra',
's_srcr_def_w',
's_srcr_inc_w',
's_srcr_ind1_w',
's_srcr_ind2_w',
'-',
's_srcr_def',
's_srcr_inc',
's_srcr_ind',
's_srcr_ind2');
group_new(0x142, 'g_dstr_wextra',
's_dstr_def_w',
's_dstr_inc_w',
's_dstr_ind1_w',
's_dstr_ind2_w',
'-',
's_dstr_def',
's_dstr_inc',
's_dstr_ind',
's_dstr_ind2');
group_new(0x143, 'g_dstw_wextra',
's_dstw_def_w',
's_dstw_inc_w',
's_dstw_incdef_w',
's_dstw_ind_w',
'-',
's_dstw_def',
's_dstw_inc',
's_dstw_ind',
's_dstw_def246');
group_new(0x144, 'g_dsta_wextra',
's_dsta_incdef_w',
's_dsta_ind_w',
'-',
's_dsta_inc',
's_dsta_ind');
group_new(0x145, 'g_op_rts_wextra',
's_op_rts_pop_w',
'-',
's_op_rts_pop');
group_new(0x146, 'g_op_jsr_wextra',
's_opa_jsr_push_w',
'-',
's_opa_jsr_push');
group_new(0x147, 'g_op_mtp_wextra',
's_opa_mtp_pop_w',
's_opa_mtp_mem_w',
'-',
's_opa_mtp',
's_opa_mtp_mem');
group_new(0x148, 'g_op_mfp_wextra',
's_opa_mfp_mem_w',
's_opa_mfp_push_w',
'-',
's_opa_mfp_mem',
's_opa_mfp_push');
group_new(0x149, 'g_int_wextra',
's_int_getpc_w',
's_int_getps_w',
's_int_pushps_w',
's_int_pushpc_w',
'-',
's_int_getpc',
's_int_getps',
's_int_pushps',
's_int_pushpc');
group_new(0x14a, 'g_rti_wextra',
's_rti_getpc_w',
's_rti_getps_w',
'-',
's_rti_getpc',
's_rti_getps');
group_new(0x14f, 'g_all_wextra',
'g_ifetch_wextra',
'g_srcr_wextra',
'g_dstr_wextra',
'g_dstw_wextra',
'g_dsta_wextra',
'g_op_rts_wextra',
'g_op_jsr_wextra',
'g_op_mtp_wextra',
'g_op_mfp_wextra',
'g_int_wextra',
'g_rti_wextra');
}
#-------------------------------------------------------------------------------
sub group_new {
my $snum = shift @_;
my $snam = shift @_;
bailout("group_new: bad snum '$snum'") if defined $snum2nam[$snum];
bailout("group_new: bad snam '$snam'") if defined $snam2num{$snam};
$snum2nam[$snum] = $snam;
$snam2num{$snam} = $snum;
$dat_all{$snam} = 0;
$dat_km{$snam} = 0;
$dat_um{$snam} = 0;
my $sign = 1.;
foreach my $val (@_) {
if ($val eq '+') { $sign = 1.; next;}
if ($val eq '-') { $sign = -1.; next;}
bailout("bad action '$val'") unless defined $snam2num{$val};
$dat_all{$snam} += $sign * $dat_all{$val};
$dat_km{$snam} += $sign * $dat_km{$val};
$dat_um{$snam} += $sign * $dat_um{$val};
}
}
#-------------------------------------------------------------------------------
sub bailout {
my ($msg) = @_;
print STDERR "dmscntanal-F: $msg\n";
exit 1;
}
#-------------------------------------------------------------------------------
sub print_help {
print "usage: dmscntanal file\n";
print " --help this message\n";
}
Reference in New Issue View Git Blame Copy Permalink