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