#!/usr/bin/perl
#
# /usr/local/bin/vmtop
#
# Copyright (C) Martin J. Bligh (mbligh@aracnet.com) Jan 2003
# Released under the GNU Public License (GPL), version 2
#
# Yes, it's a disgusting hack. Bite me.

$delay = shift(@ARGV);
$interactive = 0;

while (1) {
	slurpinfo();
	parseinfo();
	clearscreen() if ($interactive);

	printf ("Memory: %8.1f Mb      Free: %5.1f%%    Buffers: %5.1f%%   Cached: %5.1f%%\n",
		$mem_total, $mem_pct_free, $mem_pct_cached, $mem_pct_buffers );
	printf ("                       Active: %5.1f%%   Inactive: %5.1f%%\n",
		$mem_pct_active, $mem_pct_inactive);
	printf ("Lowmem: %8.1f Mb      Free: %5.1f%%       Slab: %5.1f%%   Memmap: %5.1f%%\n",
		$low_total, $low_pct_free, $low_pct_slab, $low_pct_memmap);
	printf ("                       Stacks: %5.1f%%       PMDs: %5.1f%%     PTEs: %5.1f%%\n",
		$low_pct_stacks, $low_pct_pmds, $low_pct_ptes);
	print "\nTop slabs:\n";
	foreach $slab (splice(@slabbysize, 0, 5)) {
		printf ("  %20s  %8.1f Mb  (Active: %8.1f Mb, %5.1f%% full)\n", 
			$slab, $slabsize{$slab}, $slabactsize{$slab}, 
			$slabpctfull{$slab});
	}
	exit unless $delay;
	sleep $delay;
	if ($interactive) {
		topleft();
	} else {
		print "\n------------------------------------------------\n";
	}
}

sub parseinfo
{
	$mem_total = $meminfo{'memtotal'};
	if ($slabsize{'pae_pgd'} > 0) { $pae_mode = 1; } else { $pae_mode = 0; }
	$low_total = $meminfo{'lowtotal'};
	$mem_pct_free = 100 * $meminfo{'memfree'} / $mem_total;
	$mem_pct_cached = 100 * $meminfo{'cached'} / $mem_total;
	$mem_pct_buffers = 100 * $meminfo{'buffers'} / $mem_total;
	$mem_pct_active = 100 * $meminfo{'active'} / $mem_total;
	$mem_pct_inactive = 100 * $meminfo{'inactive'} / $mem_total;

	$low_slab = $meminfo{'slab'};
	$low_pct_slab = $low_slab * 100 / $low_total;
	$low_memmap = $mem_total * 44 / (4096) ;		# Vomit
	$low_pct_memmap = 100 * $mem_memmap / $low_total;
	$low_pct_free = 100 * $meminfo{'lowfree'} / $low_total;

	$low_stacks = $nr_threads * 8 / 1024;			# vomit
	$low_pct_stacks = 100 * $low_stacks / $low_total;
	if ($pae_mode == 1) {
		$low_pmds = $nr_running * 12 / 1024;		# random = 3
	} else {
		$low_pmds = 0;
	}
	$low_pct_pmds = 100 * $low_pmds / $low_total;
	$low_ptes = $vmstat{'nr_page_table_pages'} * 4 /1024;
	$low_pct_ptes = 100 * $low_ptes / $low_total;
}

sub slurpinfo
{
	opendir(PROCDIR, "/proc") || die "no /proc";
	@procfiles = readdir PROCDIR;
	closedir PROCDIR;

	open(LOADAVG, "< /proc/loadavg") || die "no /proc/loadavg";
	while(<LOADAVG>) {
		($loadavg1, $loadavg2, $loadavg3, $nr_running, $nr_threads,
			$last_pid) = split /[\s\/]+/;
	}
	close(LOADAVG);
	
	open(VMSTAT, "< /proc/vmstat") || die "no /proc/vmstat";
	while(<VMSTAT>) {
		/^(.*)\s+(\d+)$/;
		$vmstat{$1} = $2;
	}
	close(VMSTAT);

	open(MEMINFO, "< /proc/meminfo") || die "no /proc/meminfo";
	while(<MEMINFO>) {
		/^(.*):\s+(\d+)(.*)$/;
		($name, $count, $units) = ($1, $2, $3);
		$name =~ tr/A-Z/a-z/;
		if ($units =~ /kb/i) {
			$meminfo{$name} = $count / 1024;
		} else {
			$meminfo{$name} = $count;
		}
	}
	close(MEMINFO);

	open(SLABINFO, "< /proc/slabinfo") || die "no /proc/slabinfo";
	while(<SLABINFO>) {
		split;
		my ($name, $active_obj, $total_obj, $size_obj, $active_pages, $total_pages, $pages_per_slab) = @_;
		$name =~ tr/A-Z/a-z/;
		$slabsize{$name} = $total_pages * 4 / 1024;
		$slabactsize{$name} = $active_pages * 4 / 1024;
		if ($total_obj > 0) {
			$slabpctfull{$name} = 100 * $active_obj / $total_obj;
		} else {
			$slabpctfull{$name} = 0;
		}
	}
	close(SLABINFO);
	@slabbysize = reverse (sort byslabsize (keys(%slabsize)));

	open(BUDDYINFO, "< /proc/buddyinfo") || die "no /proc/buddyinfo";
	while(<BUDDYINFO>) {
		/$Node (\d+), zone\s+(\S+)\s+(\S.*)$/;
		($node, $zone, $stat) = ($1, $2, $3);
		$zone =~ tr/A-Z/a-z/;
		@count = split /\s+/, $stat;
		$index = 0;
		while (($count = pop(@count)) ne "") {
			$buddynodeinfo[$node]{$zone}[$index] = $count;
			if ($node) {
				$buddyinfo{$zone}[$index] += $count;
			} else {
				$buddyinfo{$zone}[$index] = $count;
			}
		}
	}
	$maxorder = $index - 1;
	$numnodes = $node + 1;
	close(BUDDYINFO);
}

sub byslabsize
{
	$slabsize{$a} <=> $slabsize{$b};
}

sub topleft
{
	print "\e[1;1H";
}

sub clearscreen 
{
	print "\e[2J\e[1;1H";
}