1#!/usr/bin/perl -Tw
2#-
3# Copyright (c) 2002 Dag-Erling Coïdan Smørgrav
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10#    notice, this list of conditions and the following disclaimer
11#    in this position and unchanged.
12# 2. Redistributions in binary form must reproduce the above copyright
13#    notice, this list of conditions and the following disclaimer in the
14#    documentation and/or other materials provided with the distribution.
15# 3. The name of the author may not be used to endorse or promote products
16#    derived from this software without specific prior written permission.
17#
18# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
19# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
20# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
21# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
22# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
23# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
24# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
25# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
27# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28#
29#      $FreeBSD$
30#
31
32use strict;
33use Getopt::Std;
34
35sub usage() {
36
37    print(STDERR "usage: mtxstat [-gr] [-a|c|m|t] [-l limit]\n");
38    exit(1);
39}
40
41MAIN:{
42    my %opts;			# Command-line options
43    my $key;			# Sort key
44    my $limit;			# Output limit
45    local *PIPE;		# Pipe
46    my $header;			# Header line
47    my @names;			# Field names
48    my %data;			# Mutex data
49    my @list;			# List of entries
50
51    getopts("acgl:mrt", \%opts)
52	or usage();
53    if ($opts{'a'}) {
54	usage()
55	    if ($opts{'c'} || $opts{'m'} || $opts{'t'});
56	$key = 'avg';
57    } elsif ($opts{'c'}) {
58	usage()
59	    if ($opts{'m'} || $opts{'t'});
60	$key = 'count';
61    } elsif ($opts{'m'}) {
62	usage()
63	    if ($opts{'t'});
64	$key = 'max';
65    } elsif ($opts{'t'}) {
66	$key = 'total';
67    }
68    if ($opts{'l'}) {
69	if ($opts{'l'} !~ m/^\d+$/) {
70	    usage();
71	}
72	$limit = $opts{'l'};
73    }
74    $ENV{'PATH'} = '/bin:/sbin:/usr/bin:/usr/sbin';
75    open(PIPE, "sysctl -n debug.mutex.prof.stats|")
76	or die("open(): $!\n");
77    $header = <PIPE>;
78    chomp($header);
79    @names = split(' ', $header);
80    if (defined($key) && !grep(/^$key$/, @names)) {
81	die("can't find sort key '$key' in header\n");
82    }
83    while (<PIPE>) {
84	chomp();
85	my @fields = split(' ', $_, @names);
86	next unless @fields;
87	my %entry;
88	foreach (@names) {
89	    $entry{$_} = ($_ eq 'name') ? shift(@fields) : 0.0 + shift(@fields);
90	}
91	if ($opts{'g'}) {
92	    $entry{'name'} =~ s/^(\S+)\s+\((.*)\)$/$2/;
93	}
94	my $name = $entry{'name'};
95	if ($data{$name}) {
96	    if ($entry{'max'} > $data{$name}->{'max'}) {
97		$data{$name}->{'max'} = $entry{'max'};
98	    }
99	    $data{$name}->{'total'} += $entry{'total'};
100	    $data{$name}->{'count'} += $entry{'count'};
101	    $data{$name}->{'avg'} =
102		$data{$name}->{'total'} / $data{$name}->{'count'};
103	} else {
104	    $data{$name} = \%entry;
105	}
106    }
107    if (defined($key)) {
108	@list = sort({ $data{$a}->{$key} <=> $data{$b}->{$key} }
109		     sort(keys(%data)));
110    } else {
111	@list = sort(keys(%data));
112    }
113    if ($opts{'r'}) {
114	@list = reverse(@list);
115    }
116    print("$header\n");
117    if ($limit) {
118	while (@list > $limit) {
119	    pop(@list);
120	}
121    }
122    foreach (@list) {
123	printf("%6.0f %12.0f %11.0f %5.0f %-40.40s\n",
124	       $data{$_}->{'max'},
125	       $data{$_}->{'total'},
126	       $data{$_}->{'count'},
127	       $data{$_}->{'avg'},
128	       $data{$_}->{'name'});
129    }
130}
131