src/TraceFS/checktrace.pl

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4 # Checks assumptions on Cc* (Cache Manager) behaviour by reading TraceFS log
   5 # Copyright (C) 2003 Jan Kratochvil <project-captive@jankratochvil.net>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; exactly version 2 of June 1991 is required
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20
  21 use strict;
  22 use warnings;
  23 use Carp qw(cluck confess);
  24 use Data::Dumper;
  25
  26
  27 my $filter=0;
  28 $Data::Dumper::Sortkeys=1;
  29
  30 my %init;
  31 my %Bcb;
  32
  33 END {
  34         print Data::Dumper->Dump([\%init,\%Bcb],[qw(%init %Bcb)]) if !$filter;
  35         }
  36
  37 local $_;
  38 my $hex='0x[\dA-F]+';
  39 my(@lastmap_CcMapData,@lastmap_CcPinRead,@lastmap_CcPreparePinWrite,@lastmap_CcPinMappedData,@lastmap_CcRemapBcb);
  40 my $last_irp_mj;
  41 while (<>) {
  42         chomp;
  43         s#^ *TraceFS[(]($hex)/($hex)[)]: ## or do { print "$_\n" if $filter; next; };
  44         my($process,$thread)=($1,$2);
  45
  46         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
  47                         /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
  48                 $AllocationSize=eval($AllocationSize);
  49                 $FileSize=eval($FileSize);
  50                 0==($AllocationSize%0x200) or die;
  51                 int($AllocationSize/0x200)==int(($FileSize+0x1FF)/0x200) or die;
  52                 $ValidDataLength eq "0x".("F"x8) or eval($ValidDataLength)==$FileSize or die;
  53                 !exists $init{$FileObject} or die;
  54                 $init{$FileObject}={
  55                         "FileObject"=>$FileObject,
  56                         "size"=>$FileSize,
  57                         "unmaps"=>0,
  58                         "maps"=>[],
  59                         "line"=>$.,
  60                         "Bcb_map"=>undef(),
  61                         "Bcb_pin"=>{},
  62                         };
  63                 next;
  64                 }
  65         if (my($FileObject,$TruncateSize)=
  66                         /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
  67                 $TruncateSize=eval($TruncateSize);
  68                 next if !exists $init{$FileObject};
  69                 $init{$FileObject}->{"unmaps"}==@{$init{$FileObject}->{"maps"}} or die;
  70                 delete $init{$FileObject};
  71                 next;
  72                 }
  73
  74         if (my($FileObject,$FileOffset,$Length)=
  75                         /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
  76                 $FileOffset=eval $FileOffset;
  77                 $Length=eval $Length;
  78                 die if !(my $reg=$init{$FileObject});
  79                 die if $FileOffset+$Length>$reg->{"size"};
  80                 my $newmap={
  81                                 "FileOffset"=>$FileOffset,
  82                                 "Length"=>$Length,
  83                                 "init"=>$reg,
  84                                 "line"=>$.,
  85                                 "by"=>"CcMapData",
  86                                 };
  87                 push @{$reg->{"maps"}},$newmap;
  88                 push @lastmap_CcMapData,$newmap;
  89                 next;
  90                 }
  91         if (my($Bcb,$Buffer)=
  92                         /^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
  93                 die if !(my $lastmap=pop @lastmap_CcMapData);
  94                 $lastmap->{"Bcb"}=$Bcb;
  95                 $lastmap->{"Buffer"}=$Buffer;
  96                 $lastmap->{"process"}=$process;
  97                 $lastmap->{"thread"}=$thread;
  98                 $Bcb{$Bcb}=$lastmap->{"init"};
  99                 die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} ne $Bcb;
 100                 $lastmap->{"init"}->{"Bcb_map"}=$Bcb;
 101                 for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
 102                         die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
 103                         }
 104                 next;
 105                 }
 106
 107         if (my($FileObject,$FileOffset,$Length)=
 108                         /^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 109                 $FileOffset=eval $FileOffset;
 110                 $Length=eval $Length;
 111                 die if !(my $reg=$init{$FileObject});
 112                 die if $FileOffset+$Length>$reg->{"size"};
 113                 my $newmap={
 114                                 "FileOffset"=>$FileOffset,
 115                                 "Length"=>$Length,
 116                                 "init"=>$reg,
 117                                 "line"=>$.,
 118                                 "by"=>"CcPinRead",
 119                                 };
 120                 push @{$reg->{"maps"}},$newmap;
 121                 push @lastmap_CcPinRead,$newmap;
 122                 next;
 123                 }
 124         if (my($Bcb,$Buffer)=
 125                         /^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
 126                 die if !(my $lastmap=pop @lastmap_CcPinRead);
 127                 $lastmap->{"Bcb"}=$Bcb;
 128                 $lastmap->{"Buffer"}=$Buffer;
 129                 $lastmap->{"process"}=$process;
 130                 $lastmap->{"thread"}=$thread;
 131                 $Bcb{$Bcb}=$lastmap->{"init"};
 132                 my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
 133                 die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
 134                 for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
 135                         next if $pinoffs==$myoffs;
 136                         die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
 137                         }
 138                 $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
 139                 die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
 140                 next;
 141                 }
 142
 143         if (my($FileObject,$FileOffset,$Length)=
 144                         /^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
 145                 $FileOffset=eval $FileOffset;
 146                 $Length=eval $Length;
 147                 die if !(my $reg=$init{$FileObject});
 148                 die if $FileOffset+$Length>$reg->{"size"};
 149                 my $newmap={
 150                                 "FileOffset"=>$FileOffset,
 151                                 "Length"=>$Length,
 152                                 "init"=>$reg,
 153                                 "line"=>$.,
 154                                 "by"=>"CcPreparePinWrite",
 155                                 };
 156                 push @{$reg->{"maps"}},$newmap;
 157                 push @lastmap_CcPreparePinWrite,$newmap;
 158                 next;
 159                 }
 160         if (my($Bcb,$Buffer)=
 161                         /^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
 162                 die if !(my $lastmap=pop @lastmap_CcPreparePinWrite);
 163                 $lastmap->{"Bcb"}=$Bcb;
 164                 $lastmap->{"Buffer"}=$Buffer;
 165                 $lastmap->{"process"}=$process;
 166                 $lastmap->{"thread"}=$thread;
 167                 $Bcb{$Bcb}=$lastmap->{"init"};
 168                 my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
 169                 die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
 170                 for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
 171                         next if $pinoffs==$myoffs;
 172                         die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
 173                         }
 174                 $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
 175                 die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
 176                 next;
 177                 }
 178
 179         if (my($FileObject,$FileOffset,$Length)=
 180                         /^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 181                 $FileOffset=eval $FileOffset;
 182                 $Length=eval $Length;
 183                 die if !(my $reg=$init{$FileObject});
 184                 die if $FileOffset+$Length>$reg->{"size"};
 185                 my $newmap={
 186                                 "FileOffset"=>$FileOffset,
 187                                 "Length"=>$Length,
 188                                 "init"=>$reg,
 189                                 "line"=>$.,
 190                                 "by"=>"CcPinMappedData",
 191                                 };
 192                 push @{$reg->{"maps"}},$newmap;
 193                 push @lastmap_CcPinMappedData,$newmap;
 194                 next;
 195                 }
 196         if (my($Bcb,$Buffer)=
 197                         /^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
 198                 die if !(my $lastmap=pop @lastmap_CcPinMappedData);
 199                 $lastmap->{"Bcb"}=$Bcb;
 200                 $lastmap->{"process"}=$process;
 201                 $lastmap->{"thread"}=$thread;
 202                 $Bcb{$Bcb}=$lastmap->{"init"};
 203                 my $myoffs=$lastmap->{"FileOffset"}&~0xFFF;
 204                 die if defined $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} && $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs} ne $Bcb;
 205                 for my $pinoffs (keys(%{$lastmap->{"init"}->{"Bcb_pin"}})) {
 206                         next if $pinoffs==$myoffs;
 207                         die $pinoffs if $lastmap->{"init"}->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
 208                         }
 209                 $lastmap->{"init"}->{"Bcb_pin"}->{$myoffs}=$Bcb;
 210                 die if $lastmap->{"init"}->{"Bcb_map"} && $lastmap->{"init"}->{"Bcb_map"} eq $Bcb;
 211                 next;
 212                 }
 213
 214         if (my($Bcb)=
 215                         /^enter: CcRemapBcb: Bcb=($hex)/) {
 216                 die if !(my $reg=$Bcb{$Bcb});
 217                 my $newmap={
 218                                 "remap"=>1,
 219                                 "Bcb"=>$Bcb,
 220                                 "init"=>$reg,
 221                                 "line"=>$.,
 222                                 "by"=>"CcRemapBcb of $Bcb",
 223                                 };
 224                 push @{$reg->{"maps"}},$newmap;
 225                 push @lastmap_CcRemapBcb,$newmap;
 226                 }
 227         if (my($r)=
 228                         /^leave: CcRemapBcb: r=($hex)/) {
 229                 die if !(my $lastmap=pop @lastmap_CcRemapBcb);
 230                 $lastmap->{"process"}=$process;
 231                 $lastmap->{"thread"}=$thread;
 232                 die "CcRemapBcb enterBcb ".$lastmap->{"Bcb"}." != leaveBcb ".$r
 233                                 if $lastmap->{"Bcb"} ne $r;
 234                 next;
 235                 }
 236
 237         if (my($Bcb)=
 238                         /^enter: CcUnpinData(?:|ForThread): Bcb=($hex)/) {
 239                 die if !(my $regbcb=$Bcb{$Bcb});
 240                 $regbcb->{"unmaps"}++;
 241                 die if $regbcb->{"unmaps"}>@{$regbcb->{"maps"}};
 242                 if ($regbcb->{"unmaps"}==@{$regbcb->{"maps"}}) {
 243                         warn "Full CcUnPinData for FileObject ".$regbcb->{"FileObject"};
 244 #                       $regbcb->{"unmaps"}=0;
 245 #                       $regbcb->{"maps"}=[];
 246                         $regbcb->{"unmaps"}++;
 247                         push @{$regbcb->{"maps"}},{
 248                                         "unpinned"=>"=========================================",
 249                                         "line"=>$.,
 250                                         };
 251                         }
 252                 $regbcb->{"Bcb_map"}=undef() if $regbcb->{"Bcb_map"} && $regbcb->{"Bcb_map"} eq $Bcb;
 253                 for my $pinoffs (keys(%{$regbcb->{"Bcb_pin"}})) {
 254                         delete $regbcb->{"Bcb_pin"}->{$pinoffs} if $regbcb->{"Bcb_pin"}->{$pinoffs} eq $Bcb;
 255                         }
 256                 next;
 257                 }
 258
 259         if (my($irp_mj)=
 260                         /^enter: (IRP_MJ_.*)/) {
 261                 $last_irp_mj=$irp_mj;
 262                 next;
 263                 }
 264
 265         if (my($FileObject)=
 266                         /^debug_irp: IoStackLocation->FileObject=($hex):/) {
 267                 next if $last_irp_mj ne "IRP_MJ_CLOSE";
 268                 warn "IRP_MJ_CLOSE: still mapped $FileObject" if $init{$FileObject}->{"unmaps"}!=@{$init{$FileObject}->{"maps"}};
 269                 delete $init{$FileObject};
 270                 next;
 271                 }
 272
 273         print "$_\n" if $filter;
 274         }
 275 for my $key (keys(%init)) {
 276         warn "EXIT: still mapped $key" if $init{$key}->{"unmaps"}!=@{$init{$key}->{"maps"}};
 277         }