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 Data::Dumper;
  24
  25
  26 my $filter=0;
  27 $Data::Dumper::Sortkeys=1;
  28 my $ntfs_blocksize=0x200;
  29
  30 # $Object{"by"}="CcSomeFunction";
  31 # $Object{"line_enter"}=123;
  32 # $Object{"line_leave"}=124;
  33 # $Object{"process_thread"}="0x12345678/0x12345678";
  34 # $FileObject{$FileObject}{"FileObject"}="0x12345678";
  35 # $FileObject{$FileObject}{"Allocation"}="0x12345";
  36 # $FileObject{$FileObject}{"FileSize"}="0x12345";
  37 # $FileObject{$FileObject}{"map"}="0x12345678" (Bcb);
  38 # $FileObject{$FileObject}{"pin"}{"0x1000"}="0x12345678" (Bcb);
  39 # $FileObject{$FileObject}{"PinAccess"}=0 or 1;
  40 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
  41 # $Bcb{$Bcb}{"FileObject"}="0x12345678";
  42 # $Bcb{$Bcb}{"type"}="pin" or "map";
  43 # $Bcb{$Bcb}{"ref_count"}=1
  44 # $Bcb{$Bcb}{"FileOffset"}="0x1000" if {"type"} eq "pin";
  45 # $Bcb{$Bcb}{"Buffer"}="0x12345678";    # PAGE_SIZE-aligned for "pin", FileOffset_0-aligned for "map"
  46
  47 my %FileObject;
  48 my %Bcb;
  49
  50 END {
  51         print Data::Dumper->Dump([\%FileObject,\%Bcb],[qw(%FileObject %Bcb)]) if !$filter;
  52         }
  53
  54 my $Object;
  55
  56 sub tohex($)
  57 {
  58 my($num)=@_;
  59
  60         return sprintf("0x%X",$num);
  61 }
  62
  63 sub CcInitializeCacheMap($$$$$)
  64 {
  65 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=@_;
  66
  67         $ValidDataLength=$FileSize if $ValidDataLength==eval("0x".("F"x8));
  68         if ($FileObject{$FileObject}) {
  69 #               warn "FileObject $FileObject registered twice";
  70                 return if !(my $FObject=FObject($FileObject));
  71                 delete_FObject($FObject);
  72                 }
  73         $FileObject{$FileObject}=$Object;
  74         $Object->{"FileObject"}=$FileObject;
  75         $Object->{"AllocationSize"}=tohex($AllocationSize);
  76         $Object->{"FileSize"}=tohex($FileSize);
  77         $Object->{"map"}=undef();
  78         $Object->{"pin"}={};
  79         $Object->{"PinAccess"}=$PinAccess;
  80         CcSetFileSizes($FileObject,$AllocationSize,$FileSize,$ValidDataLength);
  81 }
  82
  83 sub FObject($)
  84 {
  85 my($FileObject)=@_;
  86
  87         my $FObject=$FileObject{$FileObject};
  88         warn "Non-existent FileObject $FileObject" if !$FObject;
  89         return $FObject;
  90 }
  91
  92 sub delete_FObject($)
  93 {
  94 my($FObject)=@_;
  95
  96         my $FileObject=$FObject->{"FileObject"};
  97         do { warn "Trailing map $_ of FileObject $FileObject during its deletion" if $_; } for ($FObject->{"map"});
  98         do { warn "Trailing pin $_ of FileObject $FileObject during its deletion" if $_; } for (values(%{$FObject->{"pin"}}));
  99         delete $FileObject{$FileObject};
 100 }
 101
 102 sub CcUninitializeCacheMap($$)
 103 {
 104 my($FileObject,$TruncateSize)=@_;
 105
 106         # CcUninitializeCacheMap() w/o CcInitializeCacheMap() is allowed:
 107         return if !$FileObject{$FileObject};
 108         return if !(my $FObject=FObject $FileObject);
 109         delete_FObject $FObject;
 110 }
 111
 112 sub CcSetFileSizes($$$$)
 113 {
 114 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
 115
 116         return if !(my $FObject=FObject $FileObject);
 117         if ($AllocationSize!=eval($FObject->{"AllocationSize"})) {
 118                 do { warn "Existing map $_ of FileObject $FileObject during CcSetAllocationSizes(),"
 119                                                 ." AllocationSize=".$FObject->{"AllocationSize"} if $_; }
 120                                 for ($FObject->{"map"});
 121                 do { warn "Existing pin $_ of FileObject $FileObject during CcSetAllocationSizes(),"
 122                                                 ." AllocationSize=".$FObject->{"AllocationSize"} if $_; }
 123                                 for (values(%{$FObject->{"pin"}}));
 124                 }
 125         # $ValidDataLength can be > $FObject->{"FileSize"};
 126         warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
 127                         if $ValidDataLength>$FileSize;
 128         warn "0 != AllocationSize ".tohex($AllocationSize)." % ntfs_blocksize ".tohex($ntfs_blocksize)
 129                         if 0!=($AllocationSize%$ntfs_blocksize);
 130         # $AllocationSize can be higher
 131         warn "FileSize ".tohex($FileSize)." > AllocationSize ".tohex($AllocationSize)
 132                         if $FileSize>$AllocationSize;
 133         $FObject->{"FileSize"}=tohex($FileSize);
 134         $FObject->{"AllocationSize"}=tohex($AllocationSize);
 135 }
 136
 137 sub BObject($)
 138 {
 139 my($Bcb)=@_;
 140
 141         my $BObject=$Bcb{$Bcb};
 142         warn "Non-existent Bcb $Bcb" if !$BObject;
 143         return $BObject;
 144 }
 145
 146 sub Bcb_conflict($;@)
 147 {
 148 my($FObject,@Bcb_list)=@_;
 149
 150         my $arg=0;
 151         my %check=(
 152                 "map"=>$FObject->{"map"},
 153                 map(("arg".($arg++)=>$_),@Bcb_list),
 154                 %{$FObject->{"pin"}},
 155                 );
 156         my %reversed;
 157         my $BufferBase; # relativized to FileOffset 0
 158         my $BufferBase_val;
 159         while (my($key,$val)=each(%check)) {
 160                 next if !defined $val;
 161                 warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of FileObject ".$FObject->{"FileObject"}
 162                                 if $reversed{$val};
 163                 # Buffer base should match even between 'map's and 'pin's
 164                 # as the data are always mapped only once.
 165                 if (my $BObject=BObject $val) {
 166                         my $Buffer=eval $BObject->{"Buffer"};
 167                         $Buffer-=eval($BObject->{"FileOffset"}) if exists $BObject->{"FileOffset"};
 168                         warn "Non-matching Bcb ".$BObject->{"type"}." $val Buffer base ".tohex($Buffer)
 169                                                         ." with Bcb ".$Bcb{$BufferBase_val}->{"type"}." $BufferBase_val BufferBase ".tohex($BufferBase)
 170                                         if defined($BufferBase) && $Buffer!=$BufferBase;
 171                         $BufferBase=$Buffer;
 172                         $BufferBase_val=$val;
 173                         }
 174                 $reversed{$val}=$key;
 175                 }
 176 }
 177
 178 # New $BObject will always be forced as the last stored reference.
 179 sub Bcb_checkref($$)
 180 {
 181 my($BObject,$ref)=@_;
 182
 183         return if !(my $FObject=FObject $BObject->{"FileObject"});
 184         my $type=$BObject->{"type"};
 185         my $Bcb=$BObject->{"Bcb"};
 186         if ($$ref) {
 187                 my $BObject2=$Bcb{$$ref};
 188                 warn "new $type Bcb $Bcb != old $type Bcb $$ref"
 189                                 if $Bcb ne $$ref;
 190                 warn "new $type $Bcb type ".$BObject->{"type"}." != old $type $$ref type ".$BObject2->{"type"}
 191                                 if $BObject->{"type"} ne $BObject2->{"type"};
 192                 warn "new $type $Bcb Buffer ".$BObject->{"Buffer"}." != old $type $$ref Buffer ".$BObject2->{"Buffer"}
 193                                 if $BObject->{"Buffer"} ne $BObject2->{"Buffer"};
 194                 }
 195         if ($$ref && $$ref eq $Bcb) {
 196                 $BObject->{"ref_count"}+=$Bcb{$$ref}->{"ref_count"};
 197                 $$ref=undef();
 198                 }
 199         $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
 200         Bcb_conflict $FObject,$Bcb;
 201         $$ref=$Bcb;
 202 }
 203
 204 sub map_new($;$$)
 205 {
 206 my($FileObject,$FileOffset,$Length)=@_;
 207
 208         return if !(my $FObject=FObject $FileObject);
 209         if (defined($FileOffset) && defined($Length)) {
 210                 warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$FObject->{"FileSize"}
 211                                 if $FileOffset+$Length>eval($FObject->{"FileSize"});
 212                 }
 213         $Object->{"FileObject"}=$FileObject;
 214         if (defined $FileOffset) {
 215                 $Object->{"FileOffset"}=tohex($FileOffset);
 216                 }
 217         $Object->{"type"}="map";
 218         $Object->{"ref_count"}=1;
 219 }
 220
 221 sub map_new_leave($;$)
 222 {
 223 my($Bcb,$Buffer)=@_;
 224
 225         $Object->{"Bcb"}=$Bcb;
 226         return if !(my $FObject=FObject $Object->{"FileObject"});
 227
 228         if (defined $Buffer) {
 229                 $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
 230                 }
 231         delete $Object->{"FileOffset"};
 232
 233         my $ref=\$FObject->{"map"};
 234         Bcb_checkref $Object,$ref;
 235 }
 236
 237 sub CcMapData($$$)
 238 {
 239 my($FileObject,$FileOffset,$Length)=@_;
 240
 241         map_new $FileObject,$FileOffset,$Length;
 242 }
 243
 244 sub CcMapData_leave($$)
 245 {
 246 my($Bcb,$Buffer)=@_;
 247
 248         map_new_leave $Bcb,$Buffer;
 249 }
 250
 251 sub pin_new($$$)
 252 {
 253 my($FileObject,$FileOffset,$Length)=@_;
 254
 255         return if !(my $FObject=FObject $FileObject);
 256         warn "Pinning of non-PinAccess FileObject $FileObject" if !$FObject->{"PinAccess"};
 257         warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$FObject->{"FileSize"}
 258                         if $FileOffset+$Length>eval($FObject->{"FileSize"});
 259         warn "Pinning Length ".tohex($Length)." > 0x1000" if $Length>0x1000;
 260         warn "Pinning across file page (start=".tohex($FileOffset).",end-1=".tohex($FileOffset+$Length-1).")"
 261                         if ($FileOffset&~0xFFF)!=(($FileOffset+$Length-1)&~0xFFF);
 262         $Object->{"FileObject"}=$FileObject;
 263         $Object->{"FileOffset"}=tohex($FileOffset);
 264         $Object->{"type"}="pin";
 265         $Object->{"ref_count"}=1;
 266 }
 267
 268 sub pin_new_leave($$)
 269 {
 270 my($Bcb,$Buffer)=@_;
 271
 272         $Object->{"Bcb"}=$Bcb;
 273         return if !(my $FObject=FObject $Object->{"FileObject"});
 274         $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"})&0xFFF));
 275         my $shift=eval($Object->{"FileOffset"})&0xFFF;
 276         $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
 277         $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 278
 279         my $ref=\$FObject->{"pin"}{$Object->{"FileOffset"}};
 280         Bcb_checkref $Object,$ref;
 281 }
 282
 283 sub CcPinRead($$$)
 284 {
 285 my($FileObject,$FileOffset,$Length)=@_;
 286
 287         pin_new $FileObject,$FileOffset,$Length;
 288 }
 289
 290 sub CcPinRead_leave($$)
 291 {
 292 my($Bcb,$Buffer)=@_;
 293
 294         pin_new_leave $Bcb,$Buffer;
 295 }
 296
 297 sub CcPreparePinWrite($$$)
 298 {
 299 my($FileObject,$FileOffset,$Length)=@_;
 300
 301         pin_new $FileObject,$FileOffset,$Length;
 302 }
 303
 304 sub CcPreparePinWrite_leave($$)
 305 {
 306 my($Bcb,$Buffer)=@_;
 307
 308         pin_new_leave $Bcb,$Buffer;
 309 }
 310
 311 sub CcPinMappedData($$$)
 312 {
 313 my($FileObject,$FileOffset,$Length)=@_;
 314
 315         pin_new $FileObject,$FileOffset,$Length;
 316 }
 317
 318 sub CcPinMappedData_leave($)
 319 {
 320 my($Bcb)=@_;
 321
 322         return if !(my $FObject=FObject $Object->{"FileObject"});
 323         do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed FileObject ".$Object->{"FileObject"}; return; }
 324                         if !(my $mapBcb=$FObject->{"map"});
 325         return if !(my $BmapObject=BObject $mapBcb);
 326         my $Buffer=tohex(eval($BmapObject->{"Buffer"})+eval($Object->{"FileOffset"}));
 327
 328         my $Bcb2=$FObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
 329         my $BObject2=BObject $Bcb2 if $Bcb2;
 330         if ($BObject2 && $BObject2->{"CcPinMappedData_double"}
 331                         && eval($BObject2->{"CcPinMappedData_double"})==eval($Object->{"FileOffset"})) {        # unaligned yet
 332                 my $BmapBuffer=eval($BmapObject->{"Buffer"})+(eval($Object->{"FileOffset"})&~0xFFF);
 333                 warn "CcPinMappedData-double cludge non-matching new Bcb $Bcb != old Bcb ".$BObject2->{"Bcb"}
 334                                 if $Bcb ne $BObject2->{"Bcb"};
 335                 warn "CcPinMappedData-double cludge non-matching Buffer new Bcb $Bcb Buffer $BmapBuffer"
 336                                                 ." != old Bcb ".$BObject2->{"Bcb"}." Buffer ".$BObject2->{"Buffer"}
 337                                 if eval($BmapBuffer)!=eval($BObject2->{"Buffer"});
 338                 return;
 339                 }
 340
 341         $Object->{"CcPinMappedData_double"}=$Object->{"FileOffset"};    # unaligned yet
 342         pin_new_leave $Bcb,$Buffer;
 343 #       print STDERR "$.:".Dumper($Object);
 344 }
 345
 346 sub CcSetDirtyPinnedData($$)
 347 {
 348 my($Bcb,$Lsn)=@_;
 349
 350         return if !(my $BObject=BObject $Bcb);
 351         delete $BObject->{"CcPinMappedData_double"};
 352 }
 353
 354 sub CcRemapBcb($)
 355 {
 356 my($Bcb)=@_;
 357
 358         return if !(my $BObject=BObject $Bcb);
 359         map_new $BObject->{"FileObject"};
 360         $Object->{"Buffer"}=tohex(eval($BObject->{"Buffer"})-eval($BObject->{"FileOffset"} || 0));
 361 }
 362
 363 sub CcRemapBcb_leave($)
 364 {
 365 my($r)=@_;
 366
 367         map_new_leave $r;
 368 }
 369
 370 sub unpin($)
 371 {
 372 my($Bcb)=@_;
 373
 374         return if !(my $BObject=BObject $Bcb);
 375         delete $BObject->{"CcPinMappedData_double"};
 376         return if --$BObject->{"ref_count"};
 377         return if !(my $FObject=FObject $BObject->{"FileObject"});
 378         if ($BObject->{"type"} eq "map") {
 379                 for my $pin (values(%{$FObject->{"pin"}})) {
 380                         warn "unpin map but CcPinMappedData pin $pin still exists"
 381                                         if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
 382                         }
 383                 }
 384         for my $ref ($BObject->{"type"} eq "map" ? \$FObject->{"map"} : \$FObject->{"pin"}{$BObject->{"FileOffset"}}) {
 385                 warn "Final unpin but ".$BObject->{"type"}." Bcb $Bcb not registered"
 386                                                 ." in FileObject ".$FObject->{"FileObject"}." ref ".($$ref || "<undef>")
 387                                 if !defined($BObject->{"OwnerPointer"}) && !($$ref && $$ref eq $Bcb);
 388                 if ($$ref && $$ref eq $Bcb) {
 389                         $$ref=undef();
 390                         delete $FObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
 391                         }
 392                 }
 393         delete $Bcb{$Bcb};
 394 }
 395
 396 sub CcUnpinData($)
 397 {
 398 my($Bcb)=@_;
 399
 400         unpin $Bcb;
 401 }
 402
 403 sub CcUnpinDataForThread($)
 404 {
 405 my($Bcb)=@_;
 406
 407         unpin $Bcb;
 408 }
 409
 410 sub CcSetBcbOwnerPointer($$)
 411 {
 412 my($Bcb,$OwnerPointer)=@_;
 413
 414         return if !(my $BObject=BObject $Bcb);
 415         warn "CcSetBcbOwnerPointer() on map Bcb $Bcb" if $BObject->{"type"} ne "pin";
 416         return if !(my $FObject=FObject $BObject->{"FileObject"});
 417         warn "Double CcSetBcbOwnerPointer() on Bcb $Bcb" if defined $BObject->{"OwnerPointer"};
 418         my $val=$FObject->{"pin"}{$BObject->{"FileOffset"}};
 419         warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
 420         delete $FObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
 421         $BObject->{"OwnerPointer"}=$OwnerPointer;
 422 }
 423
 424 sub IRP_MJ_CLOSE($)
 425 {
 426 my($FileObject)=@_;
 427
 428         return if !$FileObject{$FileObject};
 429         return if !(my $FObject=FObject $FileObject);
 430         warn "CcUnpinData() not called for FileObject $FileObject before IRP_MJ_CLOSE";
 431         delete_FObject $FObject;
 432 }
 433
 434
 435 local $_;
 436 my $hex='0x[\dA-F]+';
 437 my %last_irp_mj;
 438 my %enter_leave;
 439 while (<>) {
 440         chomp;
 441         s/\r$//;
 442         # We may get some foreign garbage without '\n' before our debug data line:
 443         s#^.*?\bTraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
 444         my($process_thread)=($1);
 445
 446         $Object=undef();
 447         if (/^enter: (\w+)/) {
 448                 $Object={};
 449                 $Object->{"by"}=$1;
 450                 $Object->{"line_enter"}=$.;
 451                 $Object->{"process_thread"}=$process_thread;
 452                 push @{$enter_leave{$process_thread}},$Object;
 453                 }
 454         if (/^leave: (\w+)/) {
 455                 warn "Empty pop stack during 'leave' of $1" if !($Object=pop @{$enter_leave{$process_thread}});
 456                 warn "Non-matching popped 'by' ".$Object->{"by"}." ne current 'leave' $1"
 457                                 if $Object->{"by"} ne $1;
 458                 $Object->{"line_leave"}=$.;
 459                 }
 460
 461         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=
 462                         /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
 463                 CcInitializeCacheMap $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength),eval($PinAccess);
 464                 next;
 465                 }
 466         if (my($FileObject,$TruncateSize)=
 467                         /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
 468                 CcUninitializeCacheMap $FileObject,eval($TruncateSize);
 469                 next;
 470                 }
 471
 472         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
 473                         /^enter: CcSetFileSizes: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex)/) {
 474                 CcSetFileSizes $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength);
 475                 next;
 476                 }
 477
 478         if (my($FileObject,$FileOffset,$Length)=
 479                         /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 480                 CcMapData $FileObject,eval($FileOffset),eval($Length);
 481                 next;
 482                 }
 483         if (my($Bcb,$Buffer)=
 484                         /^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
 485                 CcMapData_leave $Bcb,$Buffer;
 486                 next;
 487                 }
 488
 489         if (my($FileObject,$FileOffset,$Length)=
 490                         /^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 491                 CcPinRead $FileObject,eval($FileOffset),eval($Length);
 492                 next;
 493                 }
 494         if (my($Bcb,$Buffer)=
 495                         /^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
 496                 CcPinRead_leave $Bcb,$Buffer;
 497                 next;
 498                 }
 499
 500         if (my($FileObject,$FileOffset,$Length)=
 501                         /^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
 502                 CcPreparePinWrite $FileObject,eval($FileOffset),eval($Length);
 503                 next;
 504                 }
 505         if (my($Bcb,$Buffer)=
 506                         /^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
 507                 CcPreparePinWrite_leave $Bcb,$Buffer;
 508                 next;
 509                 }
 510
 511         if (my($FileObject,$FileOffset,$Length)=
 512                         /^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 513                 CcPinMappedData $FileObject,eval($FileOffset),eval($Length);
 514                 next;
 515                 }
 516         if (my($Bcb)=
 517                         /^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
 518                 CcPinMappedData_leave $Bcb;
 519                 next;
 520                 }
 521
 522         if (my($BcbVoid,$Lsn)=
 523                         /^enter: CcSetDirtyPinnedData: BcbVoid=($hex),Lsn=($hex)/) {
 524                 CcSetDirtyPinnedData $BcbVoid,$Lsn;
 525                 next;
 526                 }
 527
 528         if (my($Bcb)=
 529                         /^enter: CcRemapBcb: Bcb=($hex)/) {
 530                 CcRemapBcb $Bcb;
 531                 next;
 532                 }
 533         if (my($r)=
 534                         /^leave: CcRemapBcb: r=($hex)/) {
 535                 CcRemapBcb_leave $r;
 536                 next;
 537                 }
 538
 539         if (my($Bcb)=
 540                         /^enter: CcUnpinData: Bcb=($hex)/) {
 541                 CcUnpinData $Bcb;
 542                 next;
 543                 }
 544         if (my($Bcb)=
 545                         /^enter: CcUnpinDataForThread: Bcb=($hex)/) {
 546                 CcUnpinDataForThread $Bcb;
 547                 next;
 548                 }
 549
 550         if (my($Bcb,$OwnerPointer)=
 551                         /^enter: CcSetBcbOwnerPointer: Bcb=($hex),OwnerPointer=($hex)/) {
 552                 CcSetBcbOwnerPointer $Bcb,$OwnerPointer;
 553                 next;
 554                 }
 555
 556         if (my($irp_mj)=
 557                         /^enter: (IRP_MJ_\w+)/) {
 558                 push @{$last_irp_mj{$process_thread}},$irp_mj;
 559                 next;
 560                 }
 561         if (my($irp_mj)=
 562                         /^leave: (IRP_MJ_\w+)/) {
 563                 my $irp_mj_last=pop @{$last_irp_mj{$process_thread}};
 564                 warn "Non-matching popped IRP name irp_mj $irp_mj ne irp_mj_last $irp_mj_last"
 565                                 if $irp_mj ne $irp_mj_last;
 566                 next;
 567                 }
 568
 569         if (my($FileObject)=
 570                         /^FileObject=($hex):/) {
 571                 my $aref=$last_irp_mj{$process_thread};
 572                 my $irp_mj_last=${$aref}[$#$aref];
 573                 next if !$irp_mj_last || $irp_mj_last ne "IRP_MJ_CLOSE";
 574                 IRP_MJ_CLOSE $FileObject;
 575                 next;
 576                 }
 577
 578         print "$_\n" if $filter;
 579         }
 580 for my $FileObject (keys(%FileObject)) {
 581         warn "EXIT: still CcInitializeCacheMap FileObject $FileObject";
 582         next if !(my $FObject=FObject $FileObject);
 583         delete_FObject $FObject;
 584         }