--- /dev/null
+#! /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"}};
+ }
git://git.jankratochvil.net / captive.git / blobdiff