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