tchrist@convex.com (Tom Christiansen) (11/22/90)
Here is a program that sits around a looks at kernel memory location to
record certain values. It's like vmstat, but more generalized. It does
so by opening a pipe (ok, 2 of them) to adb and sending a it command,
then reading a line back, etc.
For example:
% vmscan
usage: ./vmscan [-sleep] symbol ...
Valid symbols are: "Context Sw (p)", "Context Sw (v)", "Disk Wait", "Free",
"Idle", "Idle 1", "Idle 2", "Idle 3", "Interrupts",
"Page Ins", "Page Outs", "Page Wait", "Pgin", "Pgout",
"Real", "Reclaims", "Runnable", "Sleeping", "Swapped",
"Sys.", "System", "System 1", "System 2", "System 3",
"System calls", "User", "User (n)", "User (n) 1", "User
(n) 2", "User (n) 3", "User 1", "User 2", "User 3",
"Virt.", "ccu0", "ccu1", "ccu2", "ccu3", "ccu4", "ccu5",
"ccu6", "ccu7"
% vmscan -2 User System "User (n)"
User System User (n)
637 61316 46089
637 61320 46108
637 61336 46132
637 61341 46166
637 61346 46192
...
Things that you'll have to change to make it work on
your system:
1) There is a table with commands like this:
User cp_time+0/wt
User (n) cp_time+4/wt
System cp_time+8/wt
The precise syntax of the adb command (Convex's is bizarre),
and especially the mapping between symbols you recognize
and the ones your kernel does will need changing.
2) The number of initial garbage lines adb puts out when
talking on a pipe may vary. It may be none. You will
find this in the code.
4) I've hard-wired $TIOCGWINSZ instead of getting it from ioctl.p[lh]
as a Careful Programmer should.
3) You should really be running perl. :-)
4) You may have to install this setgid kmem to read /dev/mem.
For true perl aficcionados:
1) You will notice that I use a dynamic format based on window size.
This is done by using an ioctl to get the window size. That
way the usage message is really cool and uses however many
columns your window has.
2) There is a subroutine called &open2 which is like a regular
open but you get both a read and a write handle. This is ok
in this case cause I know that adb reads a line at a time,
then writes a line at a time. You should be able to extract
this and use as is in other programs. In fact, this is the
main reason I'm posting this. If you don't have a recent
perl patch, quote your filehandle arguments when passing them.
--tom
#!/usr/bin/perl
#
# vmscan: read stuff out of the kernel like vmstat
# tom christiansen <tchrist@convex.com>
# look for any -sleep switch
#
if ($ARGV[0] =~ /^-(\d+)/) {
$snooze = $1;
shift;
} else {
$snooze = 30;
}
# set path so taintperl doesn't hate us if running suid
$ENV{'PATH'} = '/bin:/usr/bin:/usr/ucb:/usr/convex:/usr/local';
die "$0: can't read /dev/mem\n" unless -r '/dev/mem';
die "$0: can't read /vmunix\n" unless -r '/vmunix';
# now be very careful to keep at least one
# tab between the LHS and the RHS, and that
# LHS have no trailing spaces.
%code = split(/[\t\n]+/, <<EO_LIST);
User cp_time+0/wt
User (n) cp_time+4/wt
System cp_time+8/wt
Idle cp_time+0xc/wt
User 1 cp_time+10/wt
User (n) 1 cp_time+14/wt
System 1 cp_time+18/wt
Idle 1 cp_time+0x1c/wt
User 2 cp_time+20/wt
User (n) 2 cp_time+24/wt
System 2 cp_time+28/wt
Idle 2 cp_time+0x2c/wt
User 3 cp_time+30/wt
User (n) 3 cp_time+34/wt
System 3 cp_time+38/wt
Idle 3 cp_time+0x3c/wt
Runnable total+0/h
Disk Wait total+2/h
Page Wait total+4/h
Swapped total+8/h
Sleeping total+6/h
Virt. total+0xe/wt
Real total+0x10/wt
Free total+0x14/wt
Reclaims cnt+0x38/wt
Page Ins cnt+0x30/wt
Page Outs cnt+0x34/wt
Pgin cnt+0x38/wt
Pgout cnt+0x3c/wt
Interrupts cnt+0x10/wt
System calls cnt+0xc/wt
Context Sw (p) cnt+0/wt
Context Sw (v) cnt+0x4/wt
Sys. cnt+0xc/wt
ccu0 500/wt
ccu0 5b0/wt
ccu1 504/wt
ccu1 5b4/wt
ccu2 508/wt
ccu2 5b8/wt
ccu3 50c/wt
ccu3 5bc/wt
ccu4 510/wt
ccu4 5c0/wt
ccu5 514/wt
ccu5 5c4/wt
ccu6 518/wt
ccu6 5c8/wt
ccu7 51c/wt
ccu7 5cc/wt
EO_LIST
&usage if @ARGV <= 0;
for (@ARGV) {
next if defined $code{$_};
warn "$0: \"$_\" is an undefined entry point\n";
&usage;
}
# also helps for when we fork to keep the
# stdout buffer empty in the kid
#
select(STDOUT); $| = 1; # unbuffer
# print out symbol headers
for (@ARGV) {
print $_, "\t";
print "\t" if 8 > length;
}
print "\n";
# in case the worst happens
sub REAPER {
wait;
print STDERR "$0: kid died unexpectedly: status $?\n";
exit 2;
}
$SIG{'PIPE'} = $SIG{'CHLD'} = 'REAPER';
&open2(DAD_RDR, DAD_WTR, $cmd = 'adb -k /vmunix /dev/mem')
|| die "open2 of $cmd failed: $!";
# eat first three lines of adb noise
# fourth (and prompts) aren't printed in pipes
for $lines (1..3) {
die "error reading adb pipe" unless defined($_ = <DAD_RDR>);
}
# get all the code we need to feed the hungry adb
#
@commands = @code{@ARGV};
# ^^^^^^^^^^^^^^
# this means ($code{$ARGV[0],$code{$ARGV[1], ...})
while (1) {
print DAD_WTR join("\n", @commands), "\n";
for ($count = @commands; $count; $count--) {
&REAPER() unless defined($_ = <DAD_RDR>);
split;
print $_[1], "\t\t";
}
print "\n";
sleep $snooze;
}
sub usage {
$winsize = "\0" x 8;
$TIOCGWINSZ = 0x40087468; # should be require 'sys/ioctl.pl';
if (ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize);
} else {
$col = 80;
}
$arrows = ('<' x ($col - 25));
eval "format STDERR = \nValid symbols are: ^" .
$arrows .
"\n\$symbols\n~~ ^" .
$arrows .
"\n\$symbols\n.\n";
select(STDERR);
@keys = sort keys %code;
for (@keys) {
s/^/"/;
s/$/"/;
}
$symbols = join(", ", @keys);
print "usage: $0 [-sleep] symbol ...\n";
write;
exit 1;
}
# &open2: tom christiasen, <tchrist@convex.com>
#
#
# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
#
# spawn the given $cmd and connect $rdr for
# reading and $wtr for writing. return pid
# of child, or 0 on failure.
#
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.
#
# $wtr is left unbuffered.
#
# abort program if
# rdr or wtr are null
# pipe or fork or exec fails
sub open2 {
local($dad_rdr, $dad_wtr, $cmd) = @_;
local($kid_rdr) = 'open2_fh00';
local($kid_wtr) = 'open2_fh01';
local($kidpid);
$dad_rdr ne '' || die "open2: rdr should not be null";
$dad_wtr ne '' || die "open2: wtr should not be null";
pipe($dad_rdr, $kid_wtr) || die "open2: pipe 1 failed: $!";
pipe($kid_rdr, $dad_wtr) || die "open2: pipe 2 failed: $!";
if (($kidpid = fork) < 0) {
die "open2: fork failed: $!";
} elsif ($kidpid == 0) {
close $dad_rdr;
close $dad_wtr;
open(STDIN, ">&$kid_rdr");
open(STDOUT, ">&$kid_wtr");
exec $cmd;
die "open2: exec of $cmd failed";
}
close $kid_rdr;
close $kid_wtr;
select((select($dad_wtr), $| = 1)[0]);
$kidpid;
}