#! /usr/bin/perl
# 
# $Id$
# Checks assumptions on Cc* (Cache Manager) behaviour by reading TraceFS log
# Copyright (C) 2003 Jan Kratochvil <project-captive@jankratochvil.net>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; exactly version 2 of June 1991 is required
# 
# 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 more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


use strict;
use warnings;
use Carp qw(cluck confess);
use Data::Dumper;


my $filter=0;
$Data::Dumper::Sortkeys=1;

my %init;
my %Bcb;

END {
	print Data::Dumper->Dump([\%init,\%Bcb],[qw(%init %Bcb)]) if !$filter;
	}

local $_;
my $hex='0x[\dA-F]+';
my(@lastmap_CcMapData,@lastmap_CcPinRead,@lastmap_CcPreparePinWrite,@lastmap_CcPinMappedData,@lastmap_CcRemapBcb);
my $last_irp_mj;
while (<>) {
	chomp;
	s#^ *TraceFS[(]($hex)/($hex)[)]: ## or do { print "$_\n" if $filter; next; };
	my($process,$thread)=($1,$2);

	if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
			/^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
		$AllocationSize=eval($AllocationSize);
		$FileSize=eval($FileSize);
		0==($AllocationSize%0x200) or die;
		int($AllocationSize/0x200)==int(($FileSize+0x1FF)/0x200) or die;
		$ValidDataLength eq "0x".("F"x8) or eval($ValidDataLength)==$FileSize or die;
		!exists $init{$FileObject} or die;
		$init{$FileObject}={
			"FileObject"=>$FileObject,
			"size"=>$FileSize,
			"unmaps"=>0,
			"maps"=>[],
			"line"=>$.,
			"Bcb_map"=>undef(),
			"Bcb_pin"=>{},
			};
		next;
		}
	if (my($FileObject,$TruncateSize)=
			/^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
		$TruncateSize=eval($TruncateSize);
		next if !exists $init{$FileObject};
		$init{$FileObject}->{"unmaps"}==@{$init{$FileObject}->{"maps"}} or die;
		delete $init{$FileObject};
		next;
		}

	if (my($FileObject,$FileOffset,$Length)=
			/^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
		$FileOffset=eval $FileOffset;
		$Length=eval $Length;
		die if !(my $reg=$init{$FileObject});
		die if $FileOffset+$Length>$reg->{"size"};
		my $newmap={
				"FileOffset"=>$FileOffset,
				"Length"=>$Length,
				"init"=>$reg,
				"line"=>$.,
				"by"=>"CcMapData",
				};
		push @{$reg->{"maps"}},$newmap;
		push @lastmap_CcMapData,$newmap;
		next;
		}
	if (my($Bcb,$Buffer)=
			/^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
		die if !(my $lastmap=pop @lastmap_CcMapData);
		$lastmap->{"Bcb"}=$Bcb;
		$lastmap->{"Buffer"}=$Buffer;
		$lastmap->{"process"}=$process;
		$lastmap->{"thread"}=$thread;
		$Bcb{$Bcb}=$lastmap->{"init"};
		die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} ne $Bcb;
		$lastmap->{"init"}->{"Bcb_map"}=$Bcb;
		for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
			die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
			}
		next;
		}

	if (my($FileObject,$FileOffset,$Length)=
			/^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
		$FileOffset=eval $FileOffset;
		$Length=eval $Length;
		die if !(my $reg=$init{$FileObject});
		die if $FileOffset+$Length>$reg->{"size"};
		my $newmap={
				"FileOffset"=>$FileOffset,
				"Length"=>$Length,
				"init"=>$reg,
				"line"=>$.,
				"by"=>"CcPinRead",
				};
		push @{$reg->{"maps"}},$newmap;
		push @lastmap_CcPinRead,$newmap;
		next;
		}
	if (my($Bcb,$Buffer)=
			/^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
		die if !(my $lastmap=pop @lastmap_CcPinRead);
		$lastmap->{"Bcb"}=$Bcb;
		$lastmap->{"Buffer"}=$Buffer;
		$lastmap->{"process"}=$process;
		$lastmap->{"thread"}=$thread;
		$Bcb{$Bcb}=$lastmap->{"init"};
		my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
		die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
		for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
			next if $pinoffs==$myoffs;
			die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
			}
		$lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
		die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
		next;
		}

	if (my($FileObject,$FileOffset,$Length)=
			/^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
		$FileOffset=eval $FileOffset;
		$Length=eval $Length;
		die if !(my $reg=$init{$FileObject});
		die if $FileOffset+$Length>$reg->{"size"};
		my $newmap={
				"FileOffset"=>$FileOffset,
				"Length"=>$Length,
				"init"=>$reg,
				"line"=>$.,
				"by"=>"CcPreparePinWrite",
				};
		push @{$reg->{"maps"}},$newmap;
		push @lastmap_CcPreparePinWrite,$newmap;
		next;
		}
	if (my($Bcb,$Buffer)=
			/^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
		die if !(my $lastmap=pop @lastmap_CcPreparePinWrite);
		$lastmap->{"Bcb"}=$Bcb;
		$lastmap->{"Buffer"}=$Buffer;
		$lastmap->{"process"}=$process;
		$lastmap->{"thread"}=$thread;
		$Bcb{$Bcb}=$lastmap->{"init"};
		my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
		die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
		for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
			next if $pinoffs==$myoffs;
			die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
			}
		$lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
		die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
		next;
		}

	if (my($FileObject,$FileOffset,$Length)=
			/^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
		$FileOffset=eval $FileOffset;
		$Length=eval $Length;
		die if !(my $reg=$init{$FileObject});
		die if $FileOffset+$Length>$reg->{"size"};
		my $newmap={
				"FileOffset"=>$FileOffset,
				"Length"=>$Length,
				"init"=>$reg,
				"line"=>$.,
				"by"=>"CcPinMappedData",
				};
		push @{$reg->{"maps"}},$newmap;
		push @lastmap_CcPinMappedData,$newmap;
		next;
		}
	if (my($Bcb,$Buffer)=
			/^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
		die if !(my $lastmap=pop @lastmap_CcPinMappedData);
		$lastmap->{"Bcb"}=$Bcb;
		$lastmap->{"process"}=$process;
		$lastmap->{"thread"}=$thread;
		$Bcb{$Bcb}=$lastmap->{"init"};
		my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
		die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
		for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
			next if $pinoffs==$myoffs;
			die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
			}
		$lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
		die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
		next;
		}

	if (my($Bcb)=
			/^enter: CcRemapBcb: Bcb=($hex)/) {
		die if !(my $reg=$Bcb{$Bcb});
		my $newmap={
				"remap"=>1,
				"Bcb"=>$Bcb,
				"init"=>$reg,
				"line"=>$.,
				"by"=>"CcRemapBcb of $Bcb",
				};
		push @{$reg->{"maps"}},$newmap;
		push @lastmap_CcRemapBcb,$newmap;
		}
	if (my($r)=
			/^leave: CcRemapBcb: r=($hex)/) {
		die if !(my $lastmap=pop @lastmap_CcRemapBcb);
		$lastmap->{"process"}=$process;
		$lastmap->{"thread"}=$thread;
		die "CcRemapBcb enterBcb ".$lastmap->{"Bcb"}." != leaveBcb ".$r
				if $lastmap->{"Bcb"} ne $r;
		next;
		}

	if (my($Bcb)=
			/^enter: CcUnpinData(?:|ForThread): Bcb=($hex)/) {
		die if !(my $regbcb=$Bcb{$Bcb});
		$regbcb->{"unmaps"}++;
		die if $regbcb->{"unmaps"}>@{$regbcb->{"maps"}};
		if ($regbcb->{"unmaps"}==@{$regbcb->{"maps"}}) {
			warn "Full CcUnPinData for FileObject ".$regbcb->{"FileObject"};
#			$regbcb->{"unmaps"}=0;
#			$regbcb->{"maps"}=[];
			$regbcb->{"unmaps"}++;
			push @{$regbcb->{"maps"}},{
					"unpinned"=>"=========================================",
					"line"=>$.,
					};
			}
		$regbcb->{"Bcb_map"}=undef() if $regbcb->{"Bcb_map"} && $regbcb->{"Bcb_map"} eq $Bcb;
		for my $pinoffs (keys(%{$regbcb->{"Bcb_pin"}})) {
			delete $regbcb->{"Bcb_pin"}->{$pinoffs} if $regbcb->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
			}
		next;
		}

	if (my($irp_mj)=
			/^enter: (IRP_MJ_.*)/) {
		$last_irp_mj=$irp_mj;
		next;
		}

	if (my($FileObject)=
			/^debug_irp: IoStackLocation->FileObject=($hex):/) {
		next if $last_irp_mj ne "IRP_MJ_CLOSE";
		warn "IRP_MJ_CLOSE: still mapped $FileObject" if $init{$FileObject}->{"unmaps"}!=@{$init{$FileObject}->{"maps"}};
		delete $init{$FileObject};
		next;
		}

	print "$_\n" if $filter;
	}
for my $key (keys(%init)) {
	warn "EXIT: still mapped $key" if $init{$key}->{"unmaps"}!=@{$init{$key}->{"maps"}};
	}
