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 use Carp qw(cluck confess);
  25
  26
  27 my $filter=0;
  28 $Data::Dumper::Sortkeys=1;
  29 my $ntfs_blocksize=0x200;
  30
  31 # $Object->{"by"}="CcSomeFunction";
  32 # $Object->{"line_enter"}=123;
  33 # $Object->{"line_leave"}=124;
  34 # $Object->{"ProcessThread"}="0x12345678/0x12345678";
  35 # $Object->{"data"}[dataline]{"FileObject"}="0x12345678";
  36 # $Object->{"data"}[dataline]{"FileName"}="\filename" or undef() if NULL;
  37 # $Object->{"data"}[dataline]{"Flags"}="0x40100";
  38 # $Object->{"data"}[dataline]{"SectionObjectPointer"}="0x12345678";
  39 # $Object->{"data"}[dataline]{"SharedCacheMap"}="0x12345678";
  40 # $FileObject{$FileObject}{"FileObject"}="0x12345678";
  41 # $FileObject{$FileObject}{"SectionObjectPointer"}="0x12345678";
  42 # $SectionObjectPointer{$SectionObjectPointer}{"SectionObjectPointer"}="0x12345678";
  43 # $SectionObjectPointer{$SectionObjectPointer}{"SharedCacheMap"}="0x12345678";
  44 # $SharedCacheMap{$SharedCacheMap}{"SharedCacheMap"}="0x12345678";
  45 # $SharedCacheMap{$SharedCacheMap}{"SectionObjectPointer"}="0x12345678";
  46 # $SharedCacheMap{$SharedCacheMap}{"AllocationSize"}="0x12345";
  47 # $SharedCacheMap{$SharedCacheMap}{"FileSize"}="0x12345";
  48 # $SharedCacheMap{$SharedCacheMap}{"ref_count"}=1;
  49 # $SharedCacheMap{$SharedCacheMap}{"map"}="0x12345678" (Bcb);
  50 # $SharedCacheMap{$SharedCacheMap}{"pin"}{"0x1000"}="0x12345678" (Bcb) if !Bcb->{"OwnerPointer"};
  51 # $SharedCacheMap{$SharedCacheMap}{"PinAccess"}=0 or 1;
  52 # $SharedCacheMap{$SharedCacheMap}{"LogHandle"}="0x12345678" optional;
  53 # $SharedCacheMap{$SharedCacheMap}{"AcquireForLazyWrite"}=0;    # count
  54 # $SharedCacheMap{$SharedCacheMap}{"in_memory"}{"0x4000"}=1;    # mapped page?
  55 # $SharedCacheMap{$SharedCacheMap}{"Buffer"}="0x12345678";
  56 # $LogHandle{$LogHandle}{"LogHandle"}="0x12345678";
  57 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
  58 # $Bcb{$Bcb}{"SharedCacheMap"}="0x12345678";
  59 # $Bcb{$Bcb}{"type"}="pin" or "map";
  60 # $Bcb{$Bcb}{"ref_count"}=1;
  61 # $Bcb{$Bcb}{"FileOffset"}="0x1000" if {"type"} eq "pin";
  62 # $Bcb{$Bcb}{"Buffer"}="0x12345678";    # PAGE_SIZE-aligned for "pin", FileOffset_0-aligned for "map"
  63 # $Bcb{$Bcb}{"OwnerPointer"}="0x12345678" optional;
  64 # $Bcb{$Bcb}{"Lsn"}="0x12345678" optional;
  65 # $Bcb{$Bcb}{"dirty"}=1 optional;
  66 # $MdlChain{$MdlChain}{"MdlChain"}="0x12345678";
  67 # $MdlChain{$MdlChain}{"FileObject"}="0x12345678";
  68 # $MdlChain{$MdlChain}{"FileOffset"}="0x5000";
  69 # $MdlChain{$MdlChain}{"Length"}="0x9000";
  70
  71 my %FileObject;
  72 my %LogHandle;
  73 my %SectionObjectPointer;
  74 my %SharedCacheMap;
  75 my %Bcb;
  76 my %MdlChain;
  77 my %LastLeave;  # $ProcessThread=>[$Object,$Object,...]
  78 my $LastLeave;  # ref copy of the last item for the current $ProcessThread
  79 my $ProcessThread;
  80 my %EnterLeave;
  81 my $EnterLeave; # ref copy of the list for the current $ProcessThread
  82
  83 END {
  84         print Data::Dumper->Dump([\%FileObject,\%SectionObjectPointer,\%SharedCacheMap,\%Bcb],
  85                                [qw(%FileObject  %SectionObjectPointer  %SharedCacheMap  %Bcb)]) if !$filter;
  86         }
  87
  88 my $Object;
  89
  90 sub tohex($)
  91 {
  92 my($num)=@_;
  93
  94         return sprintf("0x%X",$num);
  95 }
  96
  97 sub FObject($)
  98 {
  99 my($FileObject)=@_;
 100
 101         my $FObject=$FileObject{$FileObject};
 102         if (!$FObject) {
 103                 my($package,$filename,$line,$subroutine)=caller 0;
 104                 warn "Non-existent FileObject $FileObject by line $line";
 105                 }
 106         return $FObject;
 107 }
 108
 109 sub delete_FObject($)
 110 {
 111 my($FObject)=@_;
 112
 113         my $FileObject=$FObject->{"FileObject"};
 114         delete $FileObject{$FileObject};
 115 }
 116
 117 sub SObject($)
 118 {
 119 my($SectionObjectPointer)=@_;
 120
 121         my $SObject=$SectionObjectPointer{$SectionObjectPointer};
 122         if (!$SObject) {
 123                 my($package,$filename,$line,$subroutine)=caller 0;
 124                 warn "Non-existent SectionObjectPointer $SectionObjectPointer by line $line"
 125                 }
 126         return $SObject;
 127 }
 128
 129 sub SObject_from_FileObject($)
 130 {
 131 my($FileObject)=@_;
 132
 133         return if !(my $FObject=FObject $FileObject);
 134         my $SObject=SObject $FObject->{"SectionObjectPointer"};
 135         if (!$SObject) {
 136                 my($package,$filename,$line,$subroutine)=caller 0;
 137                 warn "by line $line";
 138                 }
 139         return $SObject;
 140 }
 141
 142 sub delete_CObject($)
 143 {
 144 my($CObject)=@_;
 145
 146         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 147         do { warn "Trailing map $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for ($CObject->{"map"});
 148         do { warn "Trailing pin $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for (values(%{$CObject->{"pin"}}));
 149         if (my $LogHandle=$CObject->{"LogHandle"}) {
 150                 do { warn "INTERNAL: Missing LogHandle $LogHandle for SharedCacheMap $SharedCacheMap"; return; }
 151                         if !(my $LObject=$LogHandle{$LogHandle});
 152                 # Do not delete $LogHandle as it may be used by many SharedCacheMap-s
 153                 }
 154         warn "ref_count=".$CObject->{"ref_count"}." of SharedCacheMap $SharedCacheMap during its deletion"
 155                         if $CObject->{"ref_count"};
 156         delete $SharedCacheMap{$SharedCacheMap};
 157 }
 158
 159 sub CObject($)
 160 {
 161 my($SharedCacheMap)=@_;
 162
 163         my $CObject=$SharedCacheMap{$SharedCacheMap};
 164         if (!$CObject) {
 165                 my($package,$filename,$line,$subroutine)=caller 0;
 166                 warn "Non-existent SharedCacheMap $SharedCacheMap by line $line";
 167                 }
 168         return $CObject;
 169 }
 170
 171 sub CObject_from_FileObject($)
 172 {
 173 my($FileObject)=@_;
 174
 175         return if !(my $SObject=SObject_from_FileObject $FileObject);
 176         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 177         return $CObject;
 178 }
 179
 180 sub SharedCacheMap_valid($)
 181 {
 182 my($SharedCacheMap)=@_;
 183
 184         cluck if !defined $SharedCacheMap;
 185         return 0 if "0x".("F"x8) eq $SharedCacheMap;
 186         return 0 if !eval $SharedCacheMap;
 187         return 1;
 188 }
 189
 190 sub check_data($)
 191 {
 192 my($data)=@_;
 193
 194         if (!eval $data->{"SectionObjectPointer"}) {
 195                 return if $Object->{"by"} eq "IRP_MJ_CREATE";   # SectionObjectPointer is not yet initialized
 196                 warn "Existing FileObject ".$data->{"FileObject"}." but no SectionObjectPointer found"
 197                                 if $FileObject{$data->{"FileObject"}} && eval($FileObject{$data->{"FileObject"}}{"SectionObjectPointer"});
 198                 return;
 199                 }
 200         my $SectionObjectPointer=$data->{"SectionObjectPointer"};
 201         if (!SharedCacheMap_valid $data->{"SharedCacheMap"} && $SectionObjectPointer{$SectionObjectPointer}) {
 202                 return if !(my $SObject=SObject $SectionObjectPointer);
 203                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 204                 return if !eval $SharedCacheMap;
 205                 my $CObject=CObject $SharedCacheMap;
 206                 warn "Existing SectionObjectPointer ".$data->{"SectionObjectPointer"}." but no SharedCacheMap found,"
 207                                                 ." ref_count of SharedCacheMap is ".$CObject->{"ref_count"}
 208                                 if $CObject->{"ref_count"};
 209 #                               if $SectionObjectPointer{$data->{"SectionObjectPointer"}};
 210                 # SharedCacheMap was droppped by async task as it had ref_count==0.
 211                 delete_CObject $CObject;
 212                 $SObject->{"SharedCacheMap"}=tohex(0);
 213                 # FileObject is still valid!
 214                 return;
 215                 }
 216         return if !$FileObject{$data->{"FileObject"}};
 217         return if !(my $FObject=FObject $data->{"FileObject"});
 218         $SectionObjectPointer=$FObject->{"SectionObjectPointer"};
 219         return if !(my $SObject=SObject $SectionObjectPointer);
 220         warn "FileObject ".$FObject->{"FileObject"}
 221                                         ." expected SectionObjectPointer $SectionObjectPointer"
 222                                         ." but found SectionObjectPointer ".$data->{"SectionObjectPointer"}
 223                         if $SectionObjectPointer ne $data->{"SectionObjectPointer"};
 224         my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 225         warn "FileObject ".$FObject->{"FileObject"}." SectionObjectPointer ".$SObject->{"SectionObjectPointer"}
 226                                         ." expected SharedCacheMap $SharedCacheMap"
 227                                         ." but found SharedCacheMap ".$data->{"SharedCacheMap"}
 228                         if $SharedCacheMap ne $data->{"SharedCacheMap"};
 229         warn "INTERNAL: SharedCacheMap $SharedCacheMap of FileObject ".$FObject->{"FileObject"}." got destroyed"
 230                         if !$SharedCacheMap{$SharedCacheMap};
 231 }
 232
 233 sub CcInitializeCacheMap($$$$$)
 234 {
 235 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=@_;
 236
 237         $ValidDataLength=$FileSize if $ValidDataLength==eval("0x".("F"x8));
 238         $Object->{"ref_count"}=1;
 239         $Object->{"AllocationSize"}=tohex($AllocationSize);
 240         $Object->{"FileSize"}=tohex($FileSize);
 241         $Object->{"ValidDataLength"}=tohex($ValidDataLength);
 242         $Object->{"map"}=undef();
 243         $Object->{"pin"}={};
 244         $Object->{"PinAccess"}=$PinAccess;
 245         $Object->{"FileObject"}=$FileObject;
 246 }
 247
 248 sub CcInitializeCacheMap_leave()
 249 {
 250         my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 251         $Object->{"SharedCacheMap"}=$SharedCacheMap;
 252         my $old=$SharedCacheMap{$SharedCacheMap};
 253         if (!SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"} && $old) {
 254                 # SharedCacheMap got deleted in the meantime
 255                 delete_CObject CObject $SharedCacheMap;
 256                 # Either it got deleted of some foreign SectionObjectPointer
 257                 # or of the current one:
 258                 if (my $SObject=$SectionObjectPointer{$Object->{"data"}[0]{"SectionObjectPointer"}}) {
 259                         $SObject->{"SharedCacheMap"}=tohex(0);
 260                         }
 261                 $old=undef();
 262                 }
 263         if (!$old != !SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 264                 warn "Expecting old SharedCacheMap validity ".(!!$old)
 265                                 ." but found old SharedCacheMap ".$Object->{"data"}[0]{"SharedCacheMap"};
 266                 }
 267         warn "New SharedCacheMap ".$Object->{"data"}[1]{"SharedCacheMap"}." is not valid"
 268                         if !SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"};
 269         if (SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 270                 warn "Existing SharedCacheMap changed"
 271                                                 ." from ".$Object->{"data"}[0]{"SharedCacheMap"}." to ".$Object->{"data"}[1]{"SharedCacheMap"}
 272                                 if $Object->{"data"}[0]{"SharedCacheMap"} ne $Object->{"data"}[1]{"SharedCacheMap"};
 273                 }
 274         if ($old) {
 275                 for my $field (qw(AllocationSize FileSize PinAccess)) {
 276                         warn "SharedCacheMap $SharedCacheMap old instance $field ".$old->{$field}
 277                                                         ." != new instance $field ".$Object->{$field}
 278                                         if $old->{$field} ne $Object->{$field};
 279                         }
 280                 do { warn "Existing map Bcb $_ during CcInitializeCacheMap()" if $_; } for ($old->{"map"});
 281                 do { warn "Existing pin Bcb $_ during CcInitializeCacheMap()" if $_; } for (values(%{$old->{"pin"}}));
 282                 $Object->{"ref_count"}+=$old->{"ref_count"};
 283                 }
 284         $SharedCacheMap{$SharedCacheMap}=$Object;
 285
 286         warn "Changed SectionObjectPointer inside CcInitializeCacheMap()"
 287                                         ." from ".$Object->{"data"}[0]{"SectionObjectPointer"}." to ".$Object->{"data"}[1]{"SectionObjectPointer"}
 288                         if $Object->{"data"}[0]{"SectionObjectPointer"} ne $Object->{"data"}[1]{"SectionObjectPointer"};
 289         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 290
 291         my $FileObject=$Object->{"FileObject"};
 292         if (my $FObject=$FileObject{$FileObject}) {
 293                 if (my $SObject=$SectionObjectPointer{$FObject->{"SectionObjectPointer"}}) {
 294                         warn "Changed SectionObjectPointer of FileObject $FileObject"
 295                                                         ." from ".$FObject->{"SectionObjectPointer"}." to ".$SectionObjectPointer
 296                                         if $FObject->{"SectionObjectPointer"} ne $SectionObjectPointer;
 297                         }
 298                 # Otherwise SectionObjectPointer could be deleted and rebuilt async in the meantime.
 299                 }
 300         $FileObject{$FileObject}={
 301                         "FileObject"=>$FileObject,
 302                         "SectionObjectPointer"=>$SectionObjectPointer,
 303                         };
 304
 305         if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 306                 warn "Changed SharedCacheMap of SectionObjectPointer $SectionObjectPointer"
 307                                                 ." from ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 308                                 if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && eval($SObject->{"SharedCacheMap"});
 309                 }
 310         $SectionObjectPointer{$SectionObjectPointer}={
 311                         "SectionObjectPointer"=>$SectionObjectPointer,
 312                         "SharedCacheMap"=>$SharedCacheMap,
 313                         };
 314
 315         CcSetFileSizes($FileObject,map({ eval($Object->{$_}); } qw(AllocationSize FileSize ValidDataLength)));
 316         delete $Object->{$_} for (qw(FileObject ValidDataLength));
 317 }
 318
 319 sub CcUninitializeCacheMap($$)
 320 {
 321 my($FileObject,$TruncateSize)=@_;
 322
 323         $Object->{"FileObject"}=$FileObject;
 324 }
 325
 326 sub CcUninitializeCacheMap_leave($)
 327 {
 328 my($r)=@_;
 329
 330         my $FileObject=$Object->{"FileObject"};
 331         # 'r' means function success.
 332         # r=0 either if no CcInitializeCacheMap() was called at all
 333         # or if Cc was unable to detach SharedCacheMap and it remains valid
 334         # (FIXME: Do we SharedCacheMap->ref_count-- on in such case?).
 335         my $SectionObjectPointer=$FileObject{$FileObject}->{"SectionObjectPointer"} if $FileObject{$FileObject};
 336         my $SharedCacheMap=$SectionObjectPointer{$SectionObjectPointer}->{"SharedCacheMap"}
 337                         if $SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer};
 338         warn "Unexpected 'r' result $r for CcUninitializeCacheMap of FileObject $FileObject"
 339                         if !(eval($SharedCacheMap) && !SharedCacheMap_valid($Object->{"data"}[1]{"SharedCacheMap"})) != !$r;
 340         if (!eval $SharedCacheMap) {
 341                 for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"},$Object->{"data"}[1]{"SharedCacheMap"}) {
 342                         warn "Not expecting valid SharedCacheMap $SharedCacheMap"
 343                                         if SharedCacheMap_valid $SharedCacheMap;
 344                         }
 345                 return;
 346                 }
 347         for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"}) {
 348                 warn "Expecting valid SharedCacheMap $SharedCacheMap"
 349                                 if !SharedCacheMap_valid $SharedCacheMap;
 350                 }
 351         return if !(my $FObject=FObject $FileObject);
 352         return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
 353         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 354         if (--$CObject->{"ref_count"}) {
 355                 for my $SharedCacheMap ($Object->{"data"}[1]{"SharedCacheMap"}) {
 356                         warn "Expecting still valid SharedCacheMap $SharedCacheMap after CcUninitializeCacheMap()"
 357                                                         ." with ref_count=".$CObject->{"ref_count"}
 358                                         if !SharedCacheMap_valid $SharedCacheMap;
 359                         }
 360                 return;
 361                 }
 362         if (!SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"}) {
 363                 delete_CObject $CObject;
 364                 $SObject->{"SharedCacheMap"}=tohex(0);
 365                 # FileObject is still valid!
 366                 }
 367         else {
 368                 # FIXME: Do we SharedCacheMap->ref_count-- on in such case?
 369                 }
 370 }
 371
 372 sub CcSetFileSizes($$$$)
 373 {
 374 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
 375
 376         return if !(my $CObject=CObject_from_FileObject $FileObject);
 377         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 378         if ($AllocationSize!=eval($CObject->{"AllocationSize"})) {
 379                 do { warn "Existing map $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 380                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 381                                 for ($CObject->{"map"});
 382                 do { warn "Existing pin $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 383                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 384                                 for (values(%{$CObject->{"pin"}}));
 385                 # Do not: delete $CObject->{"in_memory"};
 386                 # as its keep is required by W32. Squeeze it instead:
 387                 $CObject->{"in_memory"}={ map({
 388                                 (eval($_)<$AllocationSize ? ($_=>1) : ());
 389                                 } keys(%{$CObject->{"in_memory"}})) };
 390                 }
 391         # $ValidDataLength can be > $CObject->{"FileSize"};
 392         warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
 393                         if $ValidDataLength>$FileSize;
 394         warn "0 != AllocationSize ".tohex($AllocationSize)." % ntfs_blocksize ".tohex($ntfs_blocksize)
 395                         if 0!=($AllocationSize%$ntfs_blocksize);
 396         # $AllocationSize can be higher
 397         warn "FileSize ".tohex($FileSize)." > AllocationSize ".tohex($AllocationSize)
 398                         if $FileSize>$AllocationSize;
 399         $CObject->{"FileSize"}=tohex($FileSize);
 400         $CObject->{"AllocationSize"}=tohex($AllocationSize);
 401         delete $CObject->{"Buffer"} if !eval $AllocationSize;
 402 }
 403
 404 sub IRP_MJ_CREATE_leave()
 405 {
 406         do { warn "Non-NULL SectionObjectPointer $_ not expected" if eval($_); } for ($Object->{"data"}[0]{"SectionObjectPointer"});
 407         my $FileObject=$Object->{"data"}[0]{"FileObject"};
 408         warn "Existing FileObject $FileObject not expected" if $FileObject{$FileObject};
 409         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 410         # We want to track even FileObject without SectionObjectPointer yet.
 411 #       if ($SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer})
 412         {
 413                 $FileObject{$FileObject}={
 414                                 "FileObject"=>$FileObject,
 415                                 "SectionObjectPointer"=>$SectionObjectPointer,
 416                                 };
 417                 }
 418         if (eval $SectionObjectPointer) {
 419                 my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 420                 if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 421                         warn "Changed SharedCacheMap from stored ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 422                                         if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && $Object->{"by"} ne "IRP_MJ_CREATE";
 423                         }
 424                 $SectionObjectPointer{$SectionObjectPointer}={
 425                                 "SectionObjectPointer"=>$SectionObjectPointer,
 426                                 "SharedCacheMap"=>$SharedCacheMap,
 427                                 };
 428                 }
 429 }
 430
 431 sub BObject($)
 432 {
 433 my($Bcb)=@_;
 434
 435         cluck if !defined $Bcb;
 436         my $BObject=$Bcb{$Bcb};
 437         if (!$BObject) {
 438                 my($package,$filename,$line,$subroutine)=caller 0;
 439                 warn "Non-existent Bcb $Bcb by line $line"
 440                 }
 441         return $BObject;
 442 }
 443
 444 sub delete_BObject($)
 445 {
 446 my($BObject)=@_;
 447
 448         my $Bcb=$BObject->{"Bcb"};
 449 #       warn "XXX delete_BObject 0x811799B8 line $. BObject=".Dumper $BObject if $Bcb eq "0x811799B8";
 450         warn "Deleting ref_count=".$BObject->{"ref_count"}." Bcb $Bcb" if $BObject->{"ref_count"};
 451         # Do not: warn "Deleting dirty Bcb $Bcb" if $BObject->{"dirty"};
 452         # as it is valid to allow sanity check below.
 453         warn "Deleting dirty Bcb $Bcb" if $BObject->{"dirty"} && $BObject->{"ref_count"};
 454         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 455         if ($BObject->{"type"} eq "map") {
 456                 for my $pin (values(%{$CObject->{"pin"}})) {
 457                         next if !defined $pin;
 458                         warn "unpin map but CcPinMappedData pin $pin still exists"
 459                                         if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
 460                         }
 461                 }
 462         else {
 463                 warn "unpin of pin Bcb $Bcb of SharedCacheMap ".$CObject->{"SharedCacheMap"}
 464                                                 ." although FileOffset ".$BObject->{"FileOffset"}." not in_memory"
 465                                 if !($CObject->{"in_memory"}{$BObject->{"FileOffset"}});
 466                 # Do not: delete $CObject->{"in_memory"}{$BObject->{"FileOffset"}};
 467                 # as Cache Manager is not forced to drop it.
 468 #               warn "UNMARK: SharedCacheMap ".$CObject->{"SharedCacheMap"}." FileOffset ".$BObject->{"FileOffset"};
 469                 }
 470         for my $ref ($BObject->{"type"} eq "map" ? \$CObject->{"map"} : \$CObject->{"pin"}{$BObject->{"FileOffset"}}) {
 471                 warn "Final unpin but ".$BObject->{"type"}." Bcb $Bcb not registered"
 472                                                 ." in SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref ".($$ref || "<undef>")
 473                                 if !defined($BObject->{"OwnerPointer"}) && !($$ref && $$ref eq $Bcb)
 474                                                 && !($BObject->{"ref_count"}==0 && $BObject->{"dirty"});
 475                 if ($$ref && $$ref eq $Bcb) {
 476                         $$ref=undef();
 477                         # Do not: delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
 478                         # as it would destroy $$ref slot in &Bcb_checkref '($$ref && $Bcb ne $$ref)' codepath.
 479                         }
 480                 }
 481         delete $Bcb{$Bcb};
 482 #       warn "XXX delete_BObject 0x811799B8 line $. CObject=".Dumper $CObject if $Bcb eq "0x811799B8";
 483         CObject_Buffer_check($CObject);
 484 }
 485
 486 sub MObject($)
 487 {
 488 my($MdlChain)=@_;
 489
 490         cluck if !defined $MdlChain;
 491         my $MObject=$MdlChain{$MdlChain};
 492         warn "Non-existent MdlChain $MdlChain" if !$MObject;
 493         return $MObject;
 494 }
 495
 496 sub CObject_Buffer_check($)
 497 {
 498 my($CObject)=@_;
 499
 500         my $any;
 501         for my $BObject ($CObject->{"map"},values(%{$CObject->{"pin"}})) {
 502                 # There may exist OwnerPointer-ed or dirty&unreffed standalone Bcbs bound to this SharedCacheMap
 503                 # but these are not important for Buffer reset.
 504                 next if !$BObject;
 505                 $any=1;
 506                 last;
 507                 }
 508         if (!$any) {
 509                 delete $CObject->{"Buffer"};
 510                 }
 511 }
 512
 513 sub Bcb_conflict($;@)
 514 {
 515 my($CObject,@Bcb_list)=@_;
 516
 517         my $arg=0;
 518         my %check=(
 519                 "map"=>$CObject->{"map"},
 520                 map(("arg".($arg++)=>$_),@Bcb_list),
 521                 %{$CObject->{"pin"}},
 522                 );
 523         my %reversed;
 524         my $BufferBase; # relativized to FileOffset 0
 525         my $BufferBase_val;
 526         if ($CObject->{"Buffer"}) {
 527                 $BufferBase=eval $CObject->{"Buffer"};
 528                 $BufferBase_val="SharedCacheMap Buffer";
 529                 }
 530         while (my($key,$val)=each(%check)) {
 531                 next if !defined $val;
 532                 warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
 533                                 if $reversed{$val};
 534                 # Buffer base should match even between 'map's and 'pin's
 535                 # as the data are always mapped only once.
 536                 my $BObject=$Bcb{$val};
 537                 warn "Non-existent key=$key Bcb $val"
 538 #                                               ." XXX line $. CObject=".Dumper $CObject
 539                                 if !$BObject;
 540                 if ($BObject) {
 541                         my $Buffer=eval $BObject->{"Buffer"};
 542                         $Buffer-=eval($BObject->{"FileOffset"}) if exists $BObject->{"FileOffset"};
 543                         warn "INTERNAL: Non page aligned Buffer ".tohex($Buffer)." of Bcb $val"
 544                                         if $Buffer & 0xFFF;
 545                         warn "Non-matching Bcb ".$BObject->{"type"}." $val Buffer base ".tohex($Buffer)
 546                                                         ." with".($BufferBase_val=~/^SharedCacheMap / ? "" : " Bcb ".$Bcb{$BufferBase_val}->{"type"})
 547                                                         ." $BufferBase_val BufferBase ".tohex($BufferBase)."; SharedCacheMap=".$CObject->{"SharedCacheMap"}
 548 #                                                       ." XXX line $. ".Dumper($CObject,\%Bcb)
 549                                         if defined($BufferBase) && $Buffer!=$BufferBase;
 550                         $BufferBase=$Buffer;
 551                         $BufferBase_val=$val;
 552                         }
 553                 $reversed{$val}=$key;
 554                 }
 555 }
 556
 557 # New $BObject will always be forced as the last stored reference.
 558 sub Bcb_checkref($$)
 559 {
 560 my($BObject,$ref)=@_;
 561
 562         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 563         my $type=$BObject->{"type"};
 564         my $Bcb=$BObject->{"Bcb"};
 565         if ($$ref && $Bcb ne $$ref) {
 566                 my $BObject2=$Bcb{$$ref};
 567                 warn "new $type Bcb $Bcb != old ".$BObject2->{"type"}." Bcb $$ref";
 568                 delete_BObject $BObject2;
 569                 }
 570         if ($Bcb{$Bcb}) {
 571                 my $BObject2=$Bcb{$Bcb};
 572                 warn "new $type $Bcb type ".$BObject->{"type"}." != old type $type $Bcb type ".$BObject2->{"type"}
 573                                 if $BObject->{"type"} ne $BObject2->{"type"};
 574                 warn "new $type $Bcb Buffer ".($BObject->{"Buffer"} || "<undef>")
 575                                                 ." != old $type $Bcb Buffer ".($BObject2->{"Buffer"} || "<undef>")
 576 #                                               ." XXX line $. ".Dumper($BObject,$BObject2)
 577                                 if $BObject->{"Buffer"} ne $BObject2->{"Buffer"};
 578                 }
 579         if ($Bcb{$Bcb}) {
 580                 warn "Equal Bcb?" if $Bcb{$Bcb} eq $BObject;
 581                 $Bcb{$Bcb}->{"ref_count"}+=$BObject->{"ref_count"};
 582                 $BObject=$Bcb{$Bcb};
 583                 }
 584         $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
 585         Bcb_conflict $CObject,($$ref && $$ref eq $Bcb ? () : ($Bcb));
 586         $$ref=$Bcb;
 587 }
 588
 589 sub map_new($;$$)
 590 {
 591 my($SharedCacheMap,$FileOffset,$Length)=@_;
 592
 593         return if !(my $CObject=CObject $SharedCacheMap);
 594         if (defined($FileOffset) && defined($Length)) {
 595                 warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 596                                 if $FileOffset+$Length>eval($CObject->{"FileSize"});
 597                 }
 598         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 599         if (defined $FileOffset) {
 600                 $Object->{"FileOffset"}=tohex($FileOffset);
 601                 }
 602         $Object->{"type"}="map";
 603         $Object->{"ref_count"}=1;
 604 }
 605
 606 sub map_new_from_FileObject($;$$)
 607 {
 608 my($FileObject,$FileOffset,$Length)=@_;
 609
 610         return if !(my $CObject=CObject_from_FileObject $FileObject);
 611         map_new $CObject->{"SharedCacheMap"},$FileOffset,$Length;
 612 }
 613
 614 sub map_new_leave($;$)
 615 {
 616 my($Bcb,$Buffer)=@_;
 617
 618         $Object->{"Bcb"}=$Bcb;
 619         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 620
 621         if (defined $Buffer) {
 622                 $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
 623                 }
 624         delete $Object->{"FileOffset"};
 625         $CObject->{"Buffer"}=$Object->{"Buffer"} if !$CObject->{"Buffer"};
 626         warn "Unknown Buffer during map_new_leave" if !$Object->{"Buffer"};
 627
 628         my $ref=\$CObject->{"map"};
 629         # There may exist some pin bcbs even if we are creating the new map bcb.
 630         Bcb_checkref $Object,$ref;
 631 }
 632
 633 sub CcMapData($$$)
 634 {
 635 my($FileObject,$FileOffset,$Length)=@_;
 636
 637         map_new_from_FileObject $FileObject,$FileOffset,$Length;
 638 }
 639
 640 sub CcMapData_leave($$)
 641 {
 642 my($Bcb,$Buffer)=@_;
 643
 644         map_new_leave $Bcb,$Buffer;
 645 }
 646
 647 sub pin_new($$$)
 648 {
 649 my($FileObject,$FileOffset,$Length)=@_;
 650
 651         return if !(my $CObject=CObject_from_FileObject $FileObject);
 652         warn "Pinning of non-PinAccess FileObject $FileObject" if !$CObject->{"PinAccess"};
 653         warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 654                         if $FileOffset+$Length>eval($CObject->{"FileSize"});
 655         warn "Pinning Length ".tohex($Length)." > 0x1000" if $Length>0x1000;
 656         warn "Pinning across file page (start=".tohex($FileOffset).",end-1=".tohex($FileOffset+$Length-1).")"
 657                         if ($FileOffset&~0xFFF)!=(($FileOffset+$Length-1)&~0xFFF);
 658         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 659         $Object->{"FileOffset"}=tohex($FileOffset);
 660         $Object->{"type"}="pin";
 661         $Object->{"ref_count"}=1;
 662 }
 663
 664 sub pin_new_leave($$)
 665 {
 666 my($Bcb,$Buffer)=@_;
 667
 668         $Object->{"Bcb"}=$Bcb;
 669         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 670         $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"})&0xFFF));
 671         my $shift=eval($Object->{"FileOffset"})&0xFFF;
 672         $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
 673         $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 674
 675         my $Buffer_base=tohex(eval($Object->{"Buffer"})-eval($Object->{"FileOffset"}));
 676         $CObject->{"Buffer"}=$Buffer_base if !$CObject->{"Buffer"};
 677
 678         warn "pin_new_leave() while FileOffset ".$Object->{"FileOffset"}." not in_memory"
 679                                         ." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
 680                         if !$CObject->{"in_memory"}{$Object->{"FileOffset"}};
 681
 682         my $ref=\$CObject->{"pin"}{$Object->{"FileOffset"}};
 683         # There may not exist map bcb even if we are creating the new pin bcb.
 684         Bcb_checkref $Object,$ref;
 685 #       warn "XXX pin_new_leave line $. BObject=".Dumper $Object if $Bcb eq "0x811799B8";
 686 }
 687
 688 sub CcPinRead($$$)
 689 {
 690 my($FileObject,$FileOffset,$Length)=@_;
 691
 692         pin_new $FileObject,$FileOffset,$Length;
 693 }
 694
 695 sub CcPinRead_leave($$)
 696 {
 697 my($Bcb,$Buffer)=@_;
 698
 699         pin_new_leave $Bcb,$Buffer;
 700 }
 701
 702 sub CcPreparePinWrite($$$)
 703 {
 704 my($FileObject,$FileOffset,$Length)=@_;
 705
 706         return if !(my $CObject=CObject_from_FileObject $FileObject);
 707         # Full pages do not need to be read:
 708         if (!($FileOffset&0xFFF)) {
 709                 $CObject->{"in_memory"}{tohex $FileOffset}=1;
 710                 }
 711
 712         pin_new $FileObject,$FileOffset,$Length;
 713 }
 714
 715 sub CcPreparePinWrite_leave($$)
 716 {
 717 my($Bcb,$Buffer)=@_;
 718
 719         pin_new_leave $Bcb,$Buffer;
 720         my $BObject=BObject $Bcb;
 721         $BObject->{"dirty"}=1;
 722 }
 723
 724 sub CcPinMappedData($$$)
 725 {
 726 my($FileObject,$FileOffset,$Length)=@_;
 727
 728         pin_new $FileObject,$FileOffset,$Length;
 729 }
 730
 731 sub CcPinMappedData_leave($)
 732 {
 733 my($Bcb)=@_;
 734
 735         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 736         # Do not: do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed SharedCacheMap ".$CObject->{"SharedCacheMap"}; return; }
 737         #             if !$CObject->{"map"};
 738         # as the only requirement of CcPinMappedData() is to have all the pages already 'in_memory'.
 739         my $Buffer=$CObject->{"Buffer"};
 740         warn "SharedCacheMap ".$CObject->{"SharedCacheMap"}." Buffer not known during CcPinMappedData()"
 741                         if !$Buffer;
 742         $Buffer=tohex(eval($Buffer)+eval($Object->{"FileOffset"})) if $Buffer;
 743
 744 #       my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
 745 #       my $BObject2=BObject $Bcb2 if $Bcb2;
 746
 747         pin_new_leave $Bcb,$Buffer;
 748 }
 749
 750 sub CcSetDirtyPinnedData($$)
 751 {
 752 my($Bcb,$Lsn)=@_;
 753
 754         return if !(my $BObject=BObject $Bcb);
 755         # Do not: warn "Lsn already set for Bcb $Bcb as ".$BObject->{"Lsn"}." while current Lsn=$Lsn" if $BObject->{"Lsn"};
 756         # as it is permitted.
 757         warn "Lsn goes backward for Bcb $Bcb old Lsn ".$BObject->{"Lsn"}." to a new Lsn=$Lsn"
 758                         if $BObject->{"Lsn"} && eval($BObject->{"Lsn"})>eval($Lsn);
 759         $BObject->{"Lsn"}=$Lsn if $Lsn ne "0x".("F"x8);
 760         $BObject->{"dirty"}=1;
 761         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 762 }
 763
 764 sub FlushToLsnRoutine($$)
 765 {
 766 my($LogHandle,$Lsn)=@_;
 767
 768         $Object->{"LogHandle"}=$LogHandle;
 769         $Object->{"Lsn"}=$Lsn;
 770
 771         my $obj=${$EnterLeave}[$#$EnterLeave-1];
 772         warn "FLUSH" if $obj->{"by"} eq "CcFlushCache";
 773 }
 774
 775 my $LogHandle_static;
 776 sub CcSetLogHandleForFile($$$)
 777 {
 778 my($FileObject,$LogHandle,$FlushToLsnRoutine)=@_;
 779
 780         return if !(my $CObject=CObject_from_FileObject $FileObject);
 781         warn "LogHandle ".$CObject->{"LogHandle"}." already exists for SharedCacheMap ".$CObject->{"SharedCacheMap"}
 782                         if $CObject->{"LogHandle"};
 783         return if !eval $LogHandle;     # $LogHandle may be "0x0"
 784         # ntfs.sys uses single LogHandle for its whole session:
 785         warn "Non-unique LogHandle $LogHandle while last LogHandle was $LogHandle_static"
 786                         if $LogHandle_static && $LogHandle ne $LogHandle_static;
 787         $CObject->{"LogHandle"}=$LogHandle;
 788         if (!$LogHandle{$LogHandle}) {
 789                 $LogHandle{$LogHandle}={
 790                                 "LogHandle"=>$LogHandle,
 791                                 };
 792                 }
 793 }
 794
 795 sub IRP_MJ_WRITE_leave_page($$)
 796 {
 797 my($ByteOffset,$Lsn_check)=@_;
 798
 799         my $SharedCacheMap=$Object->{"data"}[0]{"SharedCacheMap"};
 800         return if !(my $CObject=CObject $SharedCacheMap);
 801         my $FlushToLsnRoutine=$LastLeave if $LastLeave->{"by"} eq "FlushToLsnRoutine";
 802         # Do not: my $Bcb=$CObject->{"pin"}{$ByteOffset};
 803         # as Bcbs with $BObject->{"OwnerPointer"} are no longer stored in $CObject->{"pin"}.
 804         my @Bcbs;
 805         for my $Bcb (keys(%Bcb)) {
 806                 my $BObject=BObject $Bcb;
 807                 if (1
 808                                 && $BObject->{"type"} eq "pin"
 809                                 && $BObject->{"SharedCacheMap"} eq $SharedCacheMap
 810                                 && $BObject->{"FileOffset"} eq $ByteOffset) {
 811                         push @Bcbs,$Bcb;
 812                         }
 813                 }
 814         if (!@Bcbs) {
 815                 do {
 816                                 warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset as non-toplevel function"
 817                                                 ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")";
 818 #                               warn Dumper $CObject;
 819                                 # Direct IRP_MJ_WRITE can be from callbacked 'FlushToLsnRoutine'.
 820                                 # It can occur even from other callbacks ('DirtyPageRoutine' etc.)
 821                                 # but it was not needed here yet.
 822                                 } if @$EnterLeave && !(${$EnterLeave}[$#$EnterLeave]->{"by"}=~/^(?:FlushToLsnRoutine\b|IRP_MJ_)/);
 823                 warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset but FlushToLsnRoutine was preceding"
 824                                 if $FlushToLsnRoutine;
 825                 return;
 826                 }
 827         $CObject->{"in_memory"}{$ByteOffset}=1;
 828         warn "Ambiguous matching Bcbs ".join(",",@Bcbs)
 829                                         ." to SharedCacheMap $SharedCacheMap WRITE ByteOffset $ByteOffset"
 830                         if @Bcbs>=2;
 831         my $Bcb=$Bcbs[0];
 832         return if !(my $BObject=BObject $Bcb);
 833         warn "IRP_MJ_WRITE on non-dirty Bcb $Bcb" if !$BObject->{"dirty"};
 834         if ($FlushToLsnRoutine) {
 835                 push @$Lsn_check,{
 836                                 "Bcb"=>$Bcb,
 837                                 "Bcb_Lsn",$BObject->{"Lsn"},
 838                                 } if $Lsn_check;
 839                 }
 840         else {
 841                 warn "Missing preceding FlushToLsnRoutine during IRP_MJ_WRITE of Bcb $Bcb with Lsn ".$BObject->{"Lsn"}
 842                                 if $BObject->{"Lsn"};
 843                 }
 844         warn "IRP_MJ_WRITE with FlushToLsnRoutine although not in AcquireForLazyWrite or CcFlushCache"
 845                         if $FlushToLsnRoutine && !((1==@$EnterLeave && ${$EnterLeave}[0]->{"by"} eq "CcFlushCache")
 846                                                 || (2==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/
 847                                                                     && ${$EnterLeave}[1]->{"by"} eq "CcFlushCache"))
 848                                               && !($CObject->{"AcquireForLazyWrite"}>=1);
 849         warn "IRP_MJ_WRITE not the toplevel function"
 850                                                 ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
 851                         if !(0==@$EnterLeave
 852                          || (1==@$EnterLeave && ${$EnterLeave}[0]->{"by"} eq "CcFlushCache")
 853                          || (2==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/
 854                                              && ${$EnterLeave}[1]->{"by"} eq "CcFlushCache"));
 855         my $CcFlushCache=${$EnterLeave}[$#$EnterLeave];
 856         if ($CcFlushCache && $CcFlushCache->{"by"} eq "CcFlushCache") {
 857                 $CcFlushCache->{"CcFlushCached"}++;
 858                 if ($CcFlushCache->{"FileOffset"} ne "0x".("F"x8) || $CcFlushCache->{"Length"} ne "0x0") {
 859                         warn "IRP_MJ_WRITE outside of range of active CcFlushCache()"
 860                                         if eval($ByteOffset)< eval($CcFlushCache->{"FileOffset"})
 861                                         || eval($ByteOffset)>=eval($CcFlushCache->{"FileOffset"})+eval($CcFlushCache->{"Length"});
 862                         }
 863                 }
 864         # Keep $BObject->{"dirty"} there for &delete_BObject sanity checks.
 865         delete_BObject $BObject if $BObject->{"dirty"} && !$BObject->{"ref_count"};
 866 }
 867
 868 sub IRP_MJ_WRITE_leave()
 869 {
 870         return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
 871         # toplevel IRP_MJ_WRITE has no requirements
 872         return if 0==@$EnterLeave
 873                         # We do not need any outer function, just 'AcquireForLazyWrite' is enough
 874                         # for flushing Cache Manager buffers by some its LazyWriter task.
 875                         && !$CObject->{"AcquireForLazyWrite"};
 876         do { warn "Length $_ not divisible by 0x1000" if eval($_)%0x1000; } for ($Object->{"WRITE"}{"Length"});
 877         my @Lsn_check;
 878         for my $reloffs (0..(eval($Object->{"WRITE"}{"Length"})/0x1000)-1) {
 879                 IRP_MJ_WRITE_leave_page tohex(eval($Object->{"WRITE"}{"ByteOffset"})+0x1000*$reloffs),\@Lsn_check;
 880                 }
 881
 882         if ($LastLeave->{"by"} eq "FlushToLsnRoutine" && (my $FlushToLsnRoutine=$LastLeave)) {
 883                 my $Lsn_max;
 884                 for (@Lsn_check) {
 885                         my $Lsn=eval $_->{"Bcb_Lsn"};
 886                         $Lsn_max=$Lsn if !defined($Lsn_max) || $Lsn_max<$Lsn;
 887                         }
 888                 warn "FlushToLsnRoutine of line_enter ".$FlushToLsnRoutine->{"line_enter"}
 889                                                 ." got Lsn ".$FlushToLsnRoutine->{"Lsn"}." although Bcbs have "
 890                                                 .join(",",map({ "(".$_->{"Bcb"}.":".$_->{"Bcb_Lsn"}.")"; } @Lsn_check))
 891                                 if tohex($Lsn_max) ne $FlushToLsnRoutine->{"Lsn"};
 892                 }
 893 }
 894
 895 sub IRP_MJ_READ_leave()
 896 {
 897         # toplevel IRP_MJ_READ has no requirements
 898         return if 0==@$EnterLeave;
 899         my @stack=map({ $_->{"by"}=~/^IRP_MJ_/ ? () : $_ } @$EnterLeave);
 900         my $opObject=$stack[0] if 1==@stack;
 901         warn "IRP_MJ_READ not the expected function stack"
 902                                                 ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
 903                         if !($opObject->{"by"} eq "CcMapData"
 904                           || $opObject->{"by"} eq "CcCopyRead"
 905                           || $opObject->{"by"} eq "CcMdlRead"
 906                           || $opObject->{"by"} eq "CcPinRead");
 907         if ($opObject->{"by"} eq "CcMdlRead") {
 908                 do { warn "Length $_ not divisible by 0x1000" if eval($_)%0x1000; } for ($Object->{"READ"}{"Length"});
 909                 }
 910         else {
 911                 do { warn "Length $_ not 0x1000" if eval($_)!=0x1000; } for ($Object->{"READ"}{"Length"});
 912                 }
 913         my $SharedCacheMap=$Object->{"data"}[0]{"SharedCacheMap"};
 914         return if !(my $CObject=CObject $SharedCacheMap);
 915         for my $reloffs (0..eval($Object->{"READ"}{"Length"})/0x1000-1) {
 916                 my $ByteOffset=tohex(eval($Object->{"READ"}{"ByteOffset"})+$reloffs*0x1000);
 917                 # Do not: warn "Reading ByteOffset $ByteOffset into SharedCacheMap $SharedCacheMap twice"
 918                 #             if $CObject->{"in_memory"}{$ByteOffset};
 919                 # as it may be still cached there as Cache Manager is not forced to drop it.
 920                 $CObject->{"in_memory"}{$ByteOffset}=1;
 921 #               warn "MARK: SharedCacheMap ".$CObject->{"SharedCacheMap"}." FileOffset $ByteOffset";
 922                 }
 923 }
 924
 925 sub CcPurgeCacheSection($$$$$)
 926 {
 927 my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps)=@_;
 928
 929         return if !(my $CObject=CObject $SharedCacheMap);
 930         warn "Unexpected UninitializeCacheMaps $UninitializeCacheMaps" if $UninitializeCacheMaps ne "0";
 931         my $all=($FileOffset eq "0x".("F"x8) && !eval $Length);
 932         warn "Not yet implemented ranged CcPurgeCacheSection()" if !$all;
 933         do { warn "Existing map Bcb $_ during CcPurgeCacheSection()" if $_; } for ($CObject->{"map"});
 934         do { warn "Existing pin Bcb $_ during CcPurgeCacheSection()" if $_; } for (values(%{$CObject->{"pin"}}));
 935         # Primary goal of this function:
 936         delete $CObject->{"in_memory"};
 937         # Really needed:
 938         delete $CObject->{"Buffer"};
 939 }
 940
 941 sub CcFlushCache($$$$)
 942 {
 943 my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length)=@_;
 944
 945         $Object->{"CcFlushCached"}=0;
 946         $Object->{"FileOffset"}=$FileOffset;
 947         $Object->{"Length"}=$Length;
 948 }
 949
 950 sub CcFlushCache_leave($$)
 951 {
 952 my($Status,$Information)=@_;
 953
 954         warn "CcFlushCache() not the toplevel function"
 955                                                 ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
 956                         if !(0==@$EnterLeave
 957                          || (1==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/));
 958         if ($Status ne "0x".("F"x8) || $Information ne "0x".("F"x8)) {
 959                 warn "Unexpected Status $Status" if eval $Status;
 960                 warn "Unexpected Information $Information while CcFlushCached=".$Object->{"CcFlushCached"}
 961                                 if eval($Information)!=eval($Object->{"CcFlushCached"})*0x1000;
 962                 }
 963 }
 964
 965 sub CcPrepareMdlWrite($$$)
 966 {
 967 my($FileObject,$FileOffset,$Length)=@_;
 968
 969         $Object->{"FileObject"}=$FileObject;
 970         warn "FileOffset $FileOffset not divisible by 0x1000" if eval($FileOffset)%0x1000;
 971         $Object->{"FileOffset"}=$FileOffset;
 972         warn "Length $Length not divisible by 0x1000" if eval($Length)%0x1000;
 973         $Object->{"Length"}=$Length;
 974 }
 975
 976 sub CcPrepareMdlWrite_leave($$$)
 977 {
 978 my($MdlChain,$Status,$Information)=@_;
 979
 980         do { warn "Unexpected Status $Status"; return; } if eval $Status;
 981         warn "Unexpected Information $Information" if $Information ne $Object->{"Length"};
 982         warn "MdlChain $MdlChain already exists" if $MdlChain{$MdlChain};
 983         $MdlChain{$MdlChain}=$Object;
 984 }
 985
 986 sub CcMdlWriteComplete($$$)
 987 {
 988 my($FileObject,$FileOffset,$MdlChain)=@_;
 989
 990         return if !(my $MObject=MObject $MdlChain);
 991         warn "CcMdlWriteComplete() parameter FileObject $FileObject"
 992                                         ." not matching MdlChain $MdlChain FileObject ".$MObject->{"FileObject"}
 993                         if $FileObject ne $MObject->{"FileObject"};
 994         warn "CcMdlWriteComplete() parameter FileOffset $FileOffset"
 995                                         ." not matching MdlChain $MdlChain FileOffset ".$MObject->{"FileOffset"}
 996                         if $FileOffset ne $MObject->{"FileOffset"};
 997         # Propose MdlChain to a simulated Bcb.
 998         # We must split it by pages as pin can be just 0x1000 sized.
 999         return if !(my $CObject=CObject_from_FileObject $MObject->{"FileObject"});
1000         for my $reloffs (0..eval($MObject->{"Length"})/0x1000-1) {
1001                 my $BObject={ %$MObject };
1002                 $BObject->{"Bcb"}="MdlChain $MdlChain reloffs $reloffs";
1003                 $BObject->{"FileOffset"}=tohex(eval($MObject->{"FileOffset"})+$reloffs*0x1000);
1004                 $BObject->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
1005                 $BObject->{"type"}="pin";
1006                 $BObject->{"ref_count"}=0;
1007                 $BObject->{"dirty"}=1;
1008                 warn "Bcb ".$BObject->{"Bcb"}." already exists" if $Bcb{$BObject->{"Bcb"}};
1009                 $Bcb{$BObject->{"Bcb"}}=$BObject;
1010                 }
1011         delete $MdlChain{$MdlChain};
1012 }
1013
1014 sub CcMdlWriteAbort($$)
1015 {
1016 my($FileObject,$MdlChain)=@_;
1017
1018         warn "CcMdlWriteAbort() not handled";
1019 }
1020
1021 sub AcquireForLazyWrite_leave($)
1022 {
1023 my($r)=@_;
1024
1025         warn "Unexpected 'r' $r" if $r ne "1";
1026         warn "AcquireForLazyWrite() not the toplevel function" if @$EnterLeave;
1027         return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
1028         $CObject->{"AcquireForLazyWrite"}++;
1029 }
1030
1031 sub ReleaseFromLazyWrite_leave()
1032 {
1033         warn "ReleaseFromLazyWrite() not the toplevel function" if @$EnterLeave;
1034         return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
1035         warn "Invalid 'AcquireForLazyWrite' value ".$CObject->{"AcquireForLazyWrite"}
1036                         if !($CObject->{"AcquireForLazyWrite"}>=1);
1037         $CObject->{"AcquireForLazyWrite"}--;
1038 }
1039
1040 sub CcRemapBcb($)
1041 {
1042 my($Bcb)=@_;
1043
1044         return if !(my $BObject=BObject $Bcb);
1045         map_new $BObject->{"SharedCacheMap"};
1046         $Object->{"Buffer"}=tohex(eval($BObject->{"Buffer"})-eval($BObject->{"FileOffset"} || 0));
1047 }
1048
1049 sub CcRemapBcb_leave($)
1050 {
1051 my($r)=@_;
1052
1053         map_new_leave $r;
1054 }
1055
1056 sub unpin($)
1057 {
1058 my($Bcb)=@_;
1059
1060         return if !(my $BObject=BObject $Bcb);
1061         return if --$BObject->{"ref_count"};
1062         if ($BObject->{"dirty"}) {
1063                 # last unpin of unreferenced dirty Bcb will no longer allow reincarnation
1064                 # of the same Bcb to the pin map of its SharedCacheMap.
1065                 return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
1066                 warn "unpin() of pin Bcb $Bcb but it is already not registered in SharedCacheMap ".$BObject->{"SharedCacheMap"}." pin map"
1067                                 if (!$CObject->{"pin"}{$BObject->{"FileOffset"}} || $CObject->{"pin"}{$BObject->{"FileOffset"}} ne $Bcb)
1068                                                 && !$BObject->{"OwnerPointer"};
1069                 delete $CObject->{"pin"}{$BObject->{"FileOffset"}}
1070                                 if $CObject->{"pin"}{$BObject->{"FileOffset"}} && ($CObject->{"pin"}{$BObject->{"FileOffset"}} eq $Bcb);
1071                 CObject_Buffer_check $CObject;
1072                 return;
1073                 }
1074         delete_BObject $BObject;
1075 }
1076
1077 sub CcUnpinData($)
1078 {
1079 my($Bcb)=@_;
1080
1081         unpin $Bcb;
1082 }
1083
1084 sub CcUnpinDataForThread($)
1085 {
1086 my($Bcb)=@_;
1087
1088         unpin $Bcb;
1089 }
1090
1091 sub CcSetBcbOwnerPointer($$)
1092 {
1093 my($Bcb,$OwnerPointer)=@_;
1094
1095         return if !(my $BObject=BObject $Bcb);
1096         warn "CcSetBcbOwnerPointer() on map Bcb $Bcb" if $BObject->{"type"} ne "pin";
1097         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
1098         warn "Double CcSetBcbOwnerPointer() on Bcb $Bcb" if defined $BObject->{"OwnerPointer"};
1099         my $val=$CObject->{"pin"}{$BObject->{"FileOffset"}};
1100         warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
1101         delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
1102         $BObject->{"OwnerPointer"}=$OwnerPointer;
1103         CObject_Buffer_check $CObject;
1104 }
1105
1106 sub IRP_MJ_CLOSE_leave()
1107 {
1108         my $FileObject=$Object->{"data"}[0]{"FileObject"};
1109 #       # IRP_MJ_CLOSE of FileObject w/o CcInitializeCacheMap()?
1110 #       return if !$FileObject{$FileObject};
1111         return if !(my $FObject=FObject $FileObject);
1112         if (eval(my $SectionObjectPointer=$FObject->{"SectionObjectPointer"})) {
1113                 return if !(my $SObject=SObject $SectionObjectPointer);
1114                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
1115                 if (eval $SharedCacheMap) {
1116                         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
1117                         # SharedCacheMap may still exist for FCB although this FileObject gets destroyed now.
1118 #                       warn "SectionObjectPointer $SectionObjectPointer still exists during IRP_MJ_CLOSE"
1119 #                                                       ." while SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref_count ".$CObject->{"ref_count"}
1120 #                                       if $SectionObjectPointer && $CObject->{"ref_count"};
1121                         }
1122                 }
1123         delete_FObject $FObject;
1124 }
1125
1126
1127 local $_;
1128 my $hex='0x[\dA-F]+';
1129 my %last_irp_mj;
1130 while (<>) {
1131         chomp;
1132         s/\r$//;
1133         # We may get some foreign garbage without '\n' before our debug data line:
1134         # Do not use '\bTraceFS' as there really can be precediny _any_ data.
1135         s#^.*?TraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
1136         $ProcessThread=$1;
1137
1138         $Object=undef();
1139         if (/^enter: (\w+)/) {
1140                 $Object={};
1141                 $Object->{"by"}=$1;
1142                 $Object->{"line_enter"}=$.;
1143                 $Object->{"ProcessThread"}=$ProcessThread;
1144                 push @{$EnterLeave{$ProcessThread}},$Object;
1145                 }
1146         elsif (/^leave: (\w+)/) {
1147                 warn "Empty pop stack during 'leave' of $1" if !($Object=pop @{$EnterLeave{$ProcessThread}});
1148                 warn "Non-matching popped 'by' ".$Object->{"by"}." ne current 'leave' $1"
1149                                 if $Object->{"by"} ne $1;
1150                 $Object->{"line_leave"}=$.;
1151                 push @{$LastLeave{$ProcessThread}},$Object;
1152                 }
1153         elsif (my($FileObject,$FileName,$Flags,$SectionObjectPointer,$SharedCacheMap)=
1154                         /^FileObject=($hex): FileName=(?:NULL|'(.*)'),(?:ref=[+-]\d+,)?Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
1155                 my $aref=$EnterLeave{$ProcessThread};
1156                 warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
1157                 my $data={
1158                                 "FileObject"=>$FileObject,
1159                                 "FileName"=>$FileName,
1160                                 "Flags"=>$Flags,
1161                                 "SectionObjectPointer"=>$SectionObjectPointer,
1162                                 "SharedCacheMap"=>$SharedCacheMap,
1163                                 "line"=>$.,
1164                                 };
1165                 push @{$Object->{"data"}},$data;
1166                 my $isinit={ map(($_=>1),qw(
1167                                 CcInitializeCacheMap
1168                                 CcUninitializeCacheMap
1169                                 IRP_MJ_CREATE
1170                                 )) }->{$Object->{"by"}};
1171                 check_data $data
1172                                 if 1==@{$Object->{"data"}} || !$isinit;
1173                 if ($isinit) {
1174                         # Prevent 'SharedCacheMap' 0->N change by CcInitializeCacheMap() called inside.
1175                         for my $ref (@$aref[0..$#$aref-1]) {
1176                                 $ref->{"data"}[0]->{"SharedCacheMap"}=$SharedCacheMap;
1177                                 }
1178                         }
1179                 if (2<=@{$Object->{"data"}}) {
1180                         my $data_prev=$Object->{"data"}[$#{$Object->{"data"}}-1];
1181                         for my $field (qw(FileObject FileName Flags),($isinit ? () : qw(SharedCacheMap))) {
1182                                 next if !defined(my $prev=$data_prev->{$field});
1183                                 next if !defined(my $now=$data->{$field});
1184                                 my $by=$Object->{"by"};
1185                                 if ($field eq "Flags") {
1186                                         next if $by eq "IRP_MJ_CREATE" && $field eq "Flags";
1187                                         my $FO_CLEANUP_COMPLETE=0x4000;
1188                                         $now=tohex(eval($now)&~$FO_CLEANUP_COMPLETE) if $by eq "IRP_MJ_CLEANUP";
1189                                         my $FO_FILE_FAST_IO_READ=0x80000;
1190                                         $prev=tohex(eval($prev)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_CLEANUP";
1191                                         $now=tohex(eval($now)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_READ" && !(eval($prev)&$FO_FILE_FAST_IO_READ);
1192                                         my $FO_FILE_MODIFIED=0x1000;
1193                                         $now=tohex(eval($now)&~$FO_FILE_MODIFIED) if $by eq "IRP_MJ_WRITE" && !(eval($prev)&$FO_FILE_MODIFIED);
1194                                         my $FO_FILE_SIZE_CHANGED=0x2000;
1195                                         $prev=tohex(eval($prev)&~$FO_FILE_MODIFIED)
1196                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_MODIFIED);
1197                                         $prev=tohex(eval($prev)&~$FO_FILE_SIZE_CHANGED)
1198                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_SIZE_CHANGED);
1199                                         }
1200                                 next if $by eq "IRP_MJ_CLOSE" && $field eq "FileName";
1201                                 $prev=~s#\\$## if $by eq "IRP_MJ_CREATE";
1202                                 $prev="\\" if $by eq "IRP_MJ_CREATE" && $prev eq "";
1203                                 $prev=~s#:.*## if $by eq "IRP_MJ_CREATE" && $prev ne $now;
1204                                 next if $field eq "SharedCacheMap" && !SharedCacheMap_valid $prev && !SharedCacheMap_valid $now;
1205                                 do { warn "Changed data field $field, prev=".$data_prev->{$field}.", now=".$data->{$field}." by $by";
1206 #                                               print STDERR Dumper $data_prev,$data;
1207                                                 } if $prev ne $now;
1208                                 }
1209                         }
1210                 next;
1211                 }
1212         elsif (my($op,$ByteOffset,$Length)=
1213                         /^(READ|WRITE): ByteOffset=($hex),Length=($hex)/) {
1214                 my $aref=$EnterLeave{$ProcessThread};
1215                 warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
1216                 $Object->{$op}={
1217                         "ByteOffset"=>$ByteOffset,
1218                         "Length"=>$Length,
1219                         };
1220                 next;
1221                 }
1222
1223         $LastLeave=${$LastLeave{$ProcessThread}}[$#{$LastLeave{$ProcessThread}}-1];
1224         $EnterLeave=$EnterLeave{$ProcessThread};
1225
1226         if (my($r)=
1227                         /^leave: IRP_MJ_\w+: r=($hex)/) {
1228                 # Failed requests should make no consequences.
1229                 next if eval($r);
1230                 }
1231
1232         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=
1233                         /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
1234                 CcInitializeCacheMap $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength),eval($PinAccess);
1235                 next;
1236                 }
1237         if (/^leave: CcInitializeCacheMap\b/) {
1238                 CcInitializeCacheMap_leave;
1239                 next;
1240                 }
1241
1242         if (my($FileObject,$TruncateSize)=
1243                         /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
1244                 CcUninitializeCacheMap $FileObject,eval($TruncateSize);
1245                 next;
1246                 }
1247         if (my($r)=
1248                         /^leave: CcUninitializeCacheMap: r=([01])/) {
1249                 CcUninitializeCacheMap_leave $r;
1250                 next;
1251                 }
1252
1253         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
1254                         /^enter: CcSetFileSizes: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex)/) {
1255                 CcSetFileSizes $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength);
1256                 next;
1257                 }
1258
1259         if (/^leave: IRP_MJ_CREATE\b/) {
1260                 IRP_MJ_CREATE_leave;
1261                 next;
1262                 }
1263
1264         if (/^leave: IRP_MJ_CLOSE\b/) {
1265                 IRP_MJ_CLOSE_leave;
1266                 next;
1267                 }
1268
1269         if (my($FileObject,$FileOffset,$Length)=
1270                         /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1271                 CcMapData $FileObject,eval($FileOffset),eval($Length);
1272                 next;
1273                 }
1274         if (my($Bcb,$Buffer)=
1275                         /^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
1276                 CcMapData_leave $Bcb,$Buffer;
1277                 next;
1278                 }
1279
1280         if (my($FileObject,$FileOffset,$Length)=
1281                         /^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1282                 CcPinRead $FileObject,eval($FileOffset),eval($Length);
1283                 next;
1284                 }
1285         if (my($Bcb,$Buffer)=
1286                         /^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
1287                 CcPinRead_leave $Bcb,$Buffer;
1288                 next;
1289                 }
1290
1291         if (my($FileObject,$FileOffset,$Length)=
1292                         /^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
1293                 CcPreparePinWrite $FileObject,eval($FileOffset),eval($Length);
1294                 next;
1295                 }
1296         if (my($Bcb,$Buffer)=
1297                         /^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
1298                 CcPreparePinWrite_leave $Bcb,$Buffer;
1299                 next;
1300                 }
1301
1302         if (my($FileObject,$FileOffset,$Length)=
1303                         /^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1304                 CcPinMappedData $FileObject,eval($FileOffset),eval($Length);
1305                 next;
1306                 }
1307         if (my($Bcb)=
1308                         /^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
1309                 CcPinMappedData_leave $Bcb;
1310                 next;
1311                 }
1312
1313         if (my($BcbVoid,$Lsn)=
1314                         /^enter: CcSetDirtyPinnedData: BcbVoid=($hex),Lsn=($hex)/) {
1315                 CcSetDirtyPinnedData $BcbVoid,$Lsn;
1316                 next;
1317                 }
1318
1319         if (my($LogHandle,$Lsn)=
1320                         /^enter: FlushToLsnRoutine: LogHandle=($hex),Lsn=($hex)/) {
1321                 FlushToLsnRoutine $LogHandle,$Lsn;
1322                 next;
1323                 }
1324
1325         if (/^leave: IRP_MJ_READ\b/) {
1326                 IRP_MJ_READ_leave;
1327                 next;
1328                 }
1329
1330         if (my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps)=
1331                 /^enter: CcPurgeCacheSection: SectionObjectPointer=($hex),->SharedCacheMap=($hex),FileOffset=($hex),Length=($hex),UninitializeCacheMaps=([01])/) {
1332                 CcPurgeCacheSection $SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps;
1333                 next;
1334                 }
1335
1336         if (/^leave: IRP_MJ_WRITE\b/) {
1337                 IRP_MJ_WRITE_leave;
1338                 next;
1339                 }
1340
1341         if (my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length)=
1342                         /^enter: CcFlushCache: SectionObjectPointer=($hex),->SharedCacheMap=($hex),FileOffset=($hex),Length=($hex)/) {
1343                 CcFlushCache $SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length;
1344                 next;
1345                 }
1346
1347         if (my($Status,$Information)=
1348                         /^leave: CcFlushCache: IoStatus->Status=($hex),IoStatus->Information=($hex)/) {
1349                 CcFlushCache_leave $Status,$Information;
1350                 next;
1351                 }
1352
1353         if (my($r)=
1354                         /^leave: AcquireForLazyWrite: r=([01])/) {
1355                 AcquireForLazyWrite_leave $r;
1356                 }
1357
1358         if (/^leave: ReleaseFromLazyWrite\b/) {
1359                 ReleaseFromLazyWrite_leave;
1360                 }
1361
1362         if (my($FileObject,$LogHandle,$FlushToLsnRoutine)=
1363                         /^enter: CcSetLogHandleForFile: FileObject=($hex),LogHandle=($hex),FlushToLsnRoutine=($hex)/) {
1364                 CcSetLogHandleForFile $FileObject,$LogHandle,$FlushToLsnRoutine;
1365                 next;
1366                 }
1367
1368         if (my($FileObject,$FileOffset,$Length)=
1369                         /^enter: CcPrepareMdlWrite: FileObject=($hex),FileOffset=($hex),Length=($hex)/) {
1370                 CcPrepareMdlWrite $FileObject,$FileOffset,$Length;
1371                 next;
1372                 }
1373         if (my($MdlChain,$Status,$Information)=
1374                         /^leave: CcPrepareMdlWrite: MdlChain=($hex),IoStatus->Status=($hex),IoStatus->Information=($hex)/) {
1375                 CcPrepareMdlWrite_leave $MdlChain,$Status,$Information;
1376                 next;
1377                 }
1378
1379         if (my($FileObject,$FileOffset,$MdlChain)=
1380                         /^enter: CcMdlWriteComplete: FileObject=($hex),FileOffset=($hex),MdlChain=($hex)/) {
1381                 CcMdlWriteComplete $FileObject,$FileOffset,$MdlChain;
1382                 next;
1383                 }
1384
1385         if (my($FileObject,$MdlChain)=
1386                         /^enter: CcMdlWriteAbort: FileObject=($hex),MdlChain=($hex)/) {
1387                 CcMdlWriteAbort $FileObject,$MdlChain;
1388                 next;
1389                 }
1390
1391         if (my($Bcb)=
1392                         /^enter: CcRemapBcb: Bcb=($hex)/) {
1393                 CcRemapBcb $Bcb;
1394                 next;
1395                 }
1396         if (my($r)=
1397                         /^leave: CcRemapBcb: r=($hex)/) {
1398                 CcRemapBcb_leave $r;
1399                 next;
1400                 }
1401
1402         if (my($Bcb)=
1403                         /^enter: CcUnpinData: Bcb=($hex)/) {
1404                 CcUnpinData $Bcb;
1405                 next;
1406                 }
1407         if (my($Bcb)=
1408                         /^enter: CcUnpinDataForThread: Bcb=($hex)/) {
1409                 CcUnpinDataForThread $Bcb;
1410                 next;
1411                 }
1412
1413         if (my($Bcb,$OwnerPointer)=
1414                         /^enter: CcSetBcbOwnerPointer: Bcb=($hex),OwnerPointer=($hex)/) {
1415                 CcSetBcbOwnerPointer $Bcb,$OwnerPointer;
1416                 next;
1417                 }
1418
1419         print "$_\n" if $filter;
1420         }
1421 for my $FileObject (keys(%FileObject)) {
1422         warn "EXIT: still CcInitializeCacheMap FileObject $FileObject";
1423         next if !(my $FObject=FObject $FileObject);
1424         }