Fixed message typo.
[captive.git] / src / TraceFS / checktrace.pl
index 5e7b258..61c63e8 100755 (executable)
@@ -43,7 +43,7 @@ my $ntfs_blocksize=0x200;
 # $SectionObjectPointer{$SectionObjectPointer}{"SharedCacheMap"}="0x12345678";
 # $SharedCacheMap{$SharedCacheMap}{"SharedCacheMap"}="0x12345678";
 # $SharedCacheMap{$SharedCacheMap}{"SectionObjectPointer"}="0x12345678";
-# $SharedCacheMap{$SharedCacheMap}{"Allocation"}="0x12345";
+# $SharedCacheMap{$SharedCacheMap}{"AllocationSize"}="0x12345";
 # $SharedCacheMap{$SharedCacheMap}{"FileSize"}="0x12345";
 # $SharedCacheMap{$SharedCacheMap}{"ref_count"}=1;
 # $SharedCacheMap{$SharedCacheMap}{"map"}="0x12345678" (Bcb);
@@ -51,6 +51,8 @@ my $ntfs_blocksize=0x200;
 # $SharedCacheMap{$SharedCacheMap}{"PinAccess"}=0 or 1;
 # $SharedCacheMap{$SharedCacheMap}{"LogHandle"}="0x12345678" optional;
 # $SharedCacheMap{$SharedCacheMap}{"AcquireForLazyWrite"}=0;   # count
+# $SharedCacheMap{$SharedCacheMap}{"in_memory"}{"0x4000"}=1;   # mapped page?
+# $SharedCacheMap{$SharedCacheMap}{"Buffer"}="0x12345678";
 # $LogHandle{$LogHandle}{"LogHandle"}="0x12345678";
 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
 # $Bcb{$Bcb}{"SharedCacheMap"}="0x12345678";
@@ -73,9 +75,10 @@ my %SharedCacheMap;
 my %Bcb;
 my %MdlChain;
 my %LastLeave; # $ProcessThread=>[$Object,$Object,...]
-my $LastLeave; # ref copy for the current $ProcessThread
+my $LastLeave; # ref copy of the last item for the current $ProcessThread
 my $ProcessThread;
 my %EnterLeave;
+my $EnterLeave;        # ref copy of the list for the current $ProcessThread
 
 END {
        print Data::Dumper->Dump([\%FileObject,\%SectionObjectPointer,\%SharedCacheMap,\%Bcb],
@@ -148,6 +151,8 @@ my($CObject)=@_;
                        if !(my $LObject=$LogHandle{$LogHandle});
                # Do not delete $LogHandle as it may be used by many SharedCacheMap-s
                }
+       warn "ref_count=".$CObject->{"ref_count"}." of SharedCacheMap $SharedCacheMap during its deletion"
+                       if $CObject->{"ref_count"};
        delete $SharedCacheMap{$SharedCacheMap};
 }
 
@@ -210,7 +215,12 @@ my($data)=@_;
                }
        return if !$FileObject{$data->{"FileObject"}};
        return if !(my $FObject=FObject $data->{"FileObject"});
-       return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
+       $SectionObjectPointer=$FObject->{"SectionObjectPointer"};
+       return if !(my $SObject=SObject $SectionObjectPointer);
+       warn "FileObject ".$FObject->{"FileObject"}
+                                       ." expected SectionObjectPointer $SectionObjectPointer"
+                                       ." but found SectionObjectPointer ".$data->{"SectionObjectPointer"}
+                       if $SectionObjectPointer ne $data->{"SectionObjectPointer"};
        my $SharedCacheMap=$SObject->{"SharedCacheMap"};
        warn "FileObject ".$FObject->{"FileObject"}." SectionObjectPointer ".$SObject->{"SectionObjectPointer"}
                                        ." expected SharedCacheMap $SharedCacheMap"
@@ -243,8 +253,11 @@ sub CcInitializeCacheMap_leave()
        if (!SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"} && $old) {
                # SharedCacheMap got deleted in the meantime
                delete_CObject CObject $SharedCacheMap;
-               my $SObject=SObject $Object->{"data"}[0]{"SectionObjectPointer"};
-               $SObject->{"SharedCacheMap"}=tohex(0);
+               # Either it got deleted of some foreign SectionObjectPointer
+               # or of the current one:
+               if (my $SObject=$SectionObjectPointer{$Object->{"data"}[0]{"SectionObjectPointer"}}) {
+                       $SObject->{"SharedCacheMap"}=tohex(0);
+                       }
                $old=undef();
                }
        if (!$old != !SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
@@ -369,6 +382,11 @@ my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
                do { warn "Existing pin $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
                                                ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
                                for (values(%{$CObject->{"pin"}}));
+               # Do not: delete $CObject->{"in_memory"};
+               # as its keep is required by W32. Squeeze it instead:
+               $CObject->{"in_memory"}={ map({
+                               (eval($_)<$AllocationSize ? ($_=>1) : ());
+                               } keys(%{$CObject->{"in_memory"}})) };
                }
        # $ValidDataLength can be > $CObject->{"FileSize"};
        warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
@@ -380,6 +398,7 @@ my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
                        if $FileSize>$AllocationSize;
        $CObject->{"FileSize"}=tohex($FileSize);
        $CObject->{"AllocationSize"}=tohex($AllocationSize);
+       delete $CObject->{"Buffer"} if !eval $AllocationSize;
 }
 
 sub IRP_MJ_CREATE_leave()
@@ -415,7 +434,10 @@ my($Bcb)=@_;
 
        cluck if !defined $Bcb;
        my $BObject=$Bcb{$Bcb};
-       warn "Non-existent Bcb $Bcb" if !$BObject;
+       if (!$BObject) {
+               my($package,$filename,$line,$subroutine)=caller 0;
+               warn "Non-existent Bcb $Bcb by line $line"
+               }
        return $BObject;
 }
 
@@ -424,6 +446,7 @@ sub delete_BObject($)
 my($BObject)=@_;
 
        my $Bcb=$BObject->{"Bcb"};
+#      warn "XXX delete_BObject 0x811799B8 line $. BObject=".Dumper $BObject if $Bcb eq "0x811799B8";
        warn "Deleting ref_count=".$BObject->{"ref_count"}." Bcb $Bcb" if $BObject->{"ref_count"};
        # Do not: warn "Deleting dirty Bcb $Bcb" if $BObject->{"dirty"};
        # as it is valid to allow sanity check below.
@@ -436,6 +459,14 @@ my($BObject)=@_;
                                        if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
                        }
                }
+       else {
+               warn "unpin of pin Bcb $Bcb of SharedCacheMap ".$CObject->{"SharedCacheMap"}
+                                               ." although FileOffset ".$BObject->{"FileOffset"}." not in_memory"
+                               if !($CObject->{"in_memory"}{$BObject->{"FileOffset"}});
+               # Do not: delete $CObject->{"in_memory"}{$BObject->{"FileOffset"}};
+               # as Cache Manager is not forced to drop it.
+#              warn "UNMARK: SharedCacheMap ".$CObject->{"SharedCacheMap"}." FileOffset ".$BObject->{"FileOffset"};
+               }
        for my $ref ($BObject->{"type"} eq "map" ? \$CObject->{"map"} : \$CObject->{"pin"}{$BObject->{"FileOffset"}}) {
                warn "Final unpin but ".$BObject->{"type"}." Bcb $Bcb not registered"
                                                ." in SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref ".($$ref || "<undef>")
@@ -448,6 +479,8 @@ my($BObject)=@_;
                        }
                }
        delete $Bcb{$Bcb};
+#      warn "XXX delete_BObject 0x811799B8 line $. CObject=".Dumper $CObject if $Bcb eq "0x811799B8";
+       CObject_Buffer_check($CObject);
 }
 
 sub MObject($)
@@ -460,6 +493,23 @@ my($MdlChain)=@_;
        return $MObject;
 }
 
+sub CObject_Buffer_check($)
+{
+my($CObject)=@_;
+
+       my $any;
+       for my $BObject ($CObject->{"map"},values(%{$CObject->{"pin"}})) {
+               # There may exist OwnerPointer-ed or dirty&unreffed standalone Bcbs bound to this SharedCacheMap
+               # but these are not important for Buffer reset.
+               next if !$BObject;
+               $any=1;
+               last;
+               }
+       if (!$any) {
+               delete $CObject->{"Buffer"};
+               }
+}
+
 sub Bcb_conflict($;@)
 {
 my($CObject,@Bcb_list)=@_;
@@ -473,17 +523,29 @@ my($CObject,@Bcb_list)=@_;
        my %reversed;
        my $BufferBase; # relativized to FileOffset 0
        my $BufferBase_val;
+       if ($CObject->{"Buffer"}) {
+               $BufferBase=eval $CObject->{"Buffer"};
+               $BufferBase_val="SharedCacheMap Buffer";
+               }
        while (my($key,$val)=each(%check)) {
                next if !defined $val;
                warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
                                if $reversed{$val};
                # Buffer base should match even between 'map's and 'pin's
                # as the data are always mapped only once.
-               if (my $BObject=BObject $val) {
+               my $BObject=$Bcb{$val};
+               warn "Non-existent key=$key Bcb $val"
+#                                              ." XXX line $. CObject=".Dumper $CObject
+                               if !$BObject;
+               if ($BObject) {
                        my $Buffer=eval $BObject->{"Buffer"};
                        $Buffer-=eval($BObject->{"FileOffset"}) if exists $BObject->{"FileOffset"};
+                       warn "INTERNAL: Non page aligned Buffer ".tohex($Buffer)." of Bcb $val"
+                                       if $Buffer & 0xFFF;
                        warn "Non-matching Bcb ".$BObject->{"type"}." $val Buffer base ".tohex($Buffer)
-                                                       ." with Bcb ".$Bcb{$BufferBase_val}->{"type"}." $BufferBase_val BufferBase ".tohex($BufferBase)
+                                                       ." with".($BufferBase_val=~/^SharedCacheMap / ? "" : " Bcb ".$Bcb{$BufferBase_val}->{"type"})
+                                                       ." $BufferBase_val BufferBase ".tohex($BufferBase)."; SharedCacheMap=".$CObject->{"SharedCacheMap"}
+#                                                      ." XXX line $. ".Dumper($CObject,\%Bcb)
                                        if defined($BufferBase) && $Buffer!=$BufferBase;
                        $BufferBase=$Buffer;
                        $BufferBase_val=$val;
@@ -504,21 +566,23 @@ my($BObject,$ref)=@_;
                my $BObject2=$Bcb{$$ref};
                warn "new $type Bcb $Bcb != old ".$BObject2->{"type"}." Bcb $$ref";
                delete_BObject $BObject2;
-               warn "INTERNAL: Trailing ref to Bcb $$ref" if $$ref;
                }
-       if ($$ref) {
-               my $BObject2=$Bcb{$$ref};
-               warn "new $type $Bcb type ".$BObject->{"type"}." != old type $type $$ref type ".$BObject2->{"type"}
+       if ($Bcb{$Bcb}) {
+               my $BObject2=$Bcb{$Bcb};
+               warn "new $type $Bcb type ".$BObject->{"type"}." != old type $type $Bcb type ".$BObject2->{"type"}
                                if $BObject->{"type"} ne $BObject2->{"type"};
-               warn "new $type $Bcb Buffer ".$BObject->{"Buffer"}." != old $type $$ref Buffer ".$BObject2->{"Buffer"}
+               warn "new $type $Bcb Buffer ".($BObject->{"Buffer"} || "<undef>")
+                                               ." != old $type $Bcb Buffer ".($BObject2->{"Buffer"} || "<undef>")
+#                                              ." XXX line $. ".Dumper($BObject,$BObject2)
                                if $BObject->{"Buffer"} ne $BObject2->{"Buffer"};
                }
-       if ($$ref && $$ref eq $Bcb) {
-               $BObject->{"ref_count"}+=$Bcb{$$ref}->{"ref_count"};
-               $$ref=undef();
+       if ($Bcb{$Bcb}) {
+               warn "Equal Bcb?" if $Bcb{$Bcb} eq $BObject;
+               $Bcb{$Bcb}->{"ref_count"}+=$BObject->{"ref_count"};
+               $BObject=$Bcb{$Bcb};
                }
        $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
-       Bcb_conflict $CObject,$Bcb;
+       Bcb_conflict $CObject,($$ref && $$ref eq $Bcb ? () : ($Bcb));
        $$ref=$Bcb;
 }
 
@@ -558,6 +622,8 @@ my($Bcb,$Buffer)=@_;
                $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
                }
        delete $Object->{"FileOffset"};
+       $CObject->{"Buffer"}=$Object->{"Buffer"} if !$CObject->{"Buffer"};
+       warn "Unknown Buffer during map_new_leave" if !$Object->{"Buffer"};
 
        my $ref=\$CObject->{"map"};
        # There may exist some pin bcbs even if we are creating the new map bcb.
@@ -606,9 +672,17 @@ my($Bcb,$Buffer)=@_;
        $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
        $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 
+       my $Buffer_base=tohex(eval($Object->{"Buffer"})-eval($Object->{"FileOffset"}));
+       $CObject->{"Buffer"}=$Buffer_base if !$CObject->{"Buffer"};
+
+       warn "pin_new_leave() while FileOffset ".$Object->{"FileOffset"}." not in_memory"
+                                       ." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
+                       if !$CObject->{"in_memory"}{$Object->{"FileOffset"}};
+
        my $ref=\$CObject->{"pin"}{$Object->{"FileOffset"}};
        # There may not exist map bcb even if we are creating the new pin bcb.
        Bcb_checkref $Object,$ref;
+#      warn "XXX pin_new_leave line $. BObject=".Dumper $Object if $Bcb eq "0x811799B8";
 }
 
 sub CcPinRead($$$)
@@ -629,6 +703,12 @@ sub CcPreparePinWrite($$$)
 {
 my($FileObject,$FileOffset,$Length)=@_;
 
+       return if !(my $CObject=CObject_from_FileObject $FileObject);
+       # Full pages do not need to be read:
+       if (!($FileOffset&0xFFF)) {
+               $CObject->{"in_memory"}{tohex $FileOffset}=1;
+               }
+
        pin_new $FileObject,$FileOffset,$Length;
 }
 
@@ -653,13 +733,16 @@ sub CcPinMappedData_leave($)
 my($Bcb)=@_;
 
        return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
-       do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed SharedCacheMap ".$CObject->{"SharedCacheMap"}; return; }
-                       if !(my $mapBcb=$CObject->{"map"});
-       return if !(my $BmapObject=BObject $mapBcb);
-       my $Buffer=tohex(eval($BmapObject->{"Buffer"})+eval($Object->{"FileOffset"}));
+       # Do not: do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed SharedCacheMap ".$CObject->{"SharedCacheMap"}; return; }
+       #             if !$CObject->{"map"};
+       # as the only requirement of CcPinMappedData() is to have all the pages already 'in_memory'.
+       my $Buffer=$CObject->{"Buffer"};
+       warn "SharedCacheMap ".$CObject->{"SharedCacheMap"}." Buffer not known during CcPinMappedData()"
+                       if !$Buffer;
+       $Buffer=tohex(eval($Buffer)+eval($Object->{"FileOffset"})) if $Buffer;
 
-       my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
-       my $BObject2=BObject $Bcb2 if $Bcb2;
+#      my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
+#      my $BObject2=BObject $Bcb2 if $Bcb2;
 
        pin_new_leave $Bcb,$Buffer;
 }
@@ -684,6 +767,9 @@ my($LogHandle,$Lsn)=@_;
 
        $Object->{"LogHandle"}=$LogHandle;
        $Object->{"Lsn"}=$Lsn;
+
+       my $obj=${$EnterLeave}[$#$EnterLeave-1];
+       warn "FLUSH" if $obj->{"by"} eq "CcFlushCache";
 }
 
 my $LogHandle_static;
@@ -727,19 +813,18 @@ my($ByteOffset,$Lsn_check)=@_;
                }
        if (!@Bcbs) {
                do {
-                               warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset but some functions"
-                                               ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @{$EnterLeave{$ProcessThread}})).")"
-                                               ." are nested:";
+                               warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset as non-toplevel function"
+                                               ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")";
 #                              warn Dumper $CObject;
                                # Direct IRP_MJ_WRITE can be from callbacked 'FlushToLsnRoutine'.
                                # It can occur even from other callbacks ('DirtyPageRoutine' etc.)
                                # but it was not needed here yet.
-                               } if @{$EnterLeave{$ProcessThread}}
-                                               && !(${$EnterLeave{$ProcessThread}}[$#{$EnterLeave{$ProcessThread}}]->{"by"} eq "FlushToLsnRoutine");
+                               } if @$EnterLeave && !(${$EnterLeave}[$#$EnterLeave]->{"by"}=~/^(?:FlushToLsnRoutine\b|IRP_MJ_)/);
                warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset but FlushToLsnRoutine was preceding"
                                if $FlushToLsnRoutine;
                return;
                }
+       $CObject->{"in_memory"}{$ByteOffset}=1;
        warn "Ambiguous matching Bcbs ".join(",",@Bcbs)
                                        ." to SharedCacheMap $SharedCacheMap WRITE ByteOffset $ByteOffset"
                        if @Bcbs>=2;
@@ -756,14 +841,38 @@ my($ByteOffset,$Lsn_check)=@_;
                warn "Missing preceding FlushToLsnRoutine during IRP_MJ_WRITE of Bcb $Bcb with Lsn ".$BObject->{"Lsn"}
                                if $BObject->{"Lsn"};
                }
-       warn "IRP_MJ_WRITE with FlushToLsnRoutine although not in AcquireForLazyWrite"
-                       if $FlushToLsnRoutine && !($CObject->{"AcquireForLazyWrite"}>=1);
+       warn "IRP_MJ_WRITE with FlushToLsnRoutine although not in AcquireForLazyWrite or CcFlushCache"
+                       if $FlushToLsnRoutine && !((1==@$EnterLeave && ${$EnterLeave}[0]->{"by"} eq "CcFlushCache")
+                                               || (2==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/
+                                                                   && ${$EnterLeave}[1]->{"by"} eq "CcFlushCache"))
+                                             && !($CObject->{"AcquireForLazyWrite"}>=1);
+       warn "IRP_MJ_WRITE not the toplevel function"
+                                               ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
+                       if !(0==@$EnterLeave
+                        || (1==@$EnterLeave && ${$EnterLeave}[0]->{"by"} eq "CcFlushCache")
+                        || (2==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/
+                                            && ${$EnterLeave}[1]->{"by"} eq "CcFlushCache"));
+       my $CcFlushCache=${$EnterLeave}[$#$EnterLeave];
+       if ($CcFlushCache && $CcFlushCache->{"by"} eq "CcFlushCache") {
+               $CcFlushCache->{"CcFlushCached"}++;
+               if ($CcFlushCache->{"FileOffset"} ne "0x".("F"x8) || $CcFlushCache->{"Length"} ne "0x0") {
+                       warn "IRP_MJ_WRITE outside of range of active CcFlushCache()"
+                                       if eval($ByteOffset)< eval($CcFlushCache->{"FileOffset"})
+                                       || eval($ByteOffset)>=eval($CcFlushCache->{"FileOffset"})+eval($CcFlushCache->{"Length"});
+                       }
+               }
        # Keep $BObject->{"dirty"} there for &delete_BObject sanity checks.
        delete_BObject $BObject if $BObject->{"dirty"} && !$BObject->{"ref_count"};
 }
 
 sub IRP_MJ_WRITE_leave()
 {
+       return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
+       # toplevel IRP_MJ_WRITE has no requirements
+       return if 0==@$EnterLeave
+                       # We do not need any outer function, just 'AcquireForLazyWrite' is enough
+                       # for flushing Cache Manager buffers by some its LazyWriter task.
+                       && !$CObject->{"AcquireForLazyWrite"};
        do { warn "Length $_ not divisible by 0x1000" if eval($_)%0x1000; } for ($Object->{"WRITE"}{"Length"});
        my @Lsn_check;
        for my $reloffs (0..(eval($Object->{"WRITE"}{"Length"})/0x1000)-1) {
@@ -783,6 +892,76 @@ sub IRP_MJ_WRITE_leave()
                }
 }
 
+sub IRP_MJ_READ_leave()
+{
+       # toplevel IRP_MJ_READ has no requirements
+       return if 0==@$EnterLeave;
+       my @stack=map({ $_->{"by"}=~/^IRP_MJ_/ ? () : $_ } @$EnterLeave);
+       my $opObject=$stack[0] if 1==@stack;
+       warn "IRP_MJ_READ not the expected function stack"
+                                               ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
+                       if !($opObject->{"by"} eq "CcMapData"
+                         || $opObject->{"by"} eq "CcCopyRead"
+                         || $opObject->{"by"} eq "CcMdlRead"
+                         || $opObject->{"by"} eq "CcPinRead");
+       if ($opObject->{"by"} eq "CcMdlRead") {
+               do { warn "Length $_ not divisible by 0x1000" if eval($_)%0x1000; } for ($Object->{"READ"}{"Length"});
+               }
+       else {
+               do { warn "Length $_ not 0x1000" if eval($_)!=0x1000; } for ($Object->{"READ"}{"Length"});
+               }
+       my $SharedCacheMap=$Object->{"data"}[0]{"SharedCacheMap"};
+       return if !(my $CObject=CObject $SharedCacheMap);
+       for my $reloffs (0..eval($Object->{"READ"}{"Length"})/0x1000-1) {
+               my $ByteOffset=tohex(eval($Object->{"READ"}{"ByteOffset"})+$reloffs*0x1000);
+               # Do not: warn "Reading ByteOffset $ByteOffset into SharedCacheMap $SharedCacheMap twice"
+               #             if $CObject->{"in_memory"}{$ByteOffset};
+               # as it may be still cached there as Cache Manager is not forced to drop it.
+               $CObject->{"in_memory"}{$ByteOffset}=1;
+#              warn "MARK: SharedCacheMap ".$CObject->{"SharedCacheMap"}." FileOffset $ByteOffset";
+               }
+}
+
+sub CcPurgeCacheSection($$$$$)
+{
+my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps)=@_;
+
+       return if !(my $CObject=CObject $SharedCacheMap);
+       warn "Unexpected UninitializeCacheMaps $UninitializeCacheMaps" if $UninitializeCacheMaps ne "0";
+       my $all=($FileOffset eq "0x".("F"x8) && !eval $Length);
+       warn "Not yet implemented ranged CcPurgeCacheSection()" if !$all;
+       do { warn "Existing map Bcb $_ during CcPurgeCacheSection()" if $_; } for ($CObject->{"map"});
+       do { warn "Existing pin Bcb $_ during CcPurgeCacheSection()" if $_; } for (values(%{$CObject->{"pin"}}));
+       # Primary goal of this function:
+       delete $CObject->{"in_memory"};
+       # Really needed:
+       delete $CObject->{"Buffer"};
+}
+
+sub CcFlushCache($$$$)
+{
+my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length)=@_;
+
+       $Object->{"CcFlushCached"}=0;
+       $Object->{"FileOffset"}=$FileOffset;
+       $Object->{"Length"}=$Length;
+}
+
+sub CcFlushCache_leave($$)
+{
+my($Status,$Information)=@_;
+
+       warn "CcFlushCache() not the toplevel function"
+                                               ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @$EnterLeave)).")"
+                       if !(0==@$EnterLeave
+                        || (1==@$EnterLeave && ${$EnterLeave}[0]->{"by"}=~/^IRP_MJ_/));
+       if ($Status ne "0x".("F"x8) || $Information ne "0x".("F"x8)) {
+               warn "Unexpected Status $Status" if eval $Status;
+               warn "Unexpected Information $Information while CcFlushCached=".$Object->{"CcFlushCached"}
+                               if eval($Information)!=eval($Object->{"CcFlushCached"})*0x1000;
+               }
+}
+
 sub CcPrepareMdlWrite($$$)
 {
 my($FileObject,$FileOffset,$Length)=@_;
@@ -844,12 +1023,14 @@ sub AcquireForLazyWrite_leave($)
 my($r)=@_;
 
        warn "Unexpected 'r' $r" if $r ne "1";
+       warn "AcquireForLazyWrite() not the toplevel function" if @$EnterLeave;
        return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
        $CObject->{"AcquireForLazyWrite"}++;
 }
 
 sub ReleaseFromLazyWrite_leave()
 {
+       warn "ReleaseFromLazyWrite() not the toplevel function" if @$EnterLeave;
        return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
        warn "Invalid 'AcquireForLazyWrite' value ".$CObject->{"AcquireForLazyWrite"}
                        if !($CObject->{"AcquireForLazyWrite"}>=1);
@@ -887,6 +1068,7 @@ my($Bcb)=@_;
                                                && !$BObject->{"OwnerPointer"};
                delete $CObject->{"pin"}{$BObject->{"FileOffset"}}
                                if $CObject->{"pin"}{$BObject->{"FileOffset"}} && ($CObject->{"pin"}{$BObject->{"FileOffset"}} eq $Bcb);
+               CObject_Buffer_check $CObject;
                return;
                }
        delete_BObject $BObject;
@@ -918,6 +1100,7 @@ my($Bcb,$OwnerPointer)=@_;
        warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
        delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
        $BObject->{"OwnerPointer"}=$OwnerPointer;
+       CObject_Buffer_check $CObject;
 }
 
 sub IRP_MJ_CLOSE_leave()
@@ -968,7 +1151,7 @@ while (<>) {
                push @{$LastLeave{$ProcessThread}},$Object;
                }
        elsif (my($FileObject,$FileName,$Flags,$SectionObjectPointer,$SharedCacheMap)=
-                       /^FileObject=($hex): FileName=(?:NULL|'(.*)'),Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
+                       /^FileObject=($hex): FileName=(?:NULL|'(.*)'),(?:ref=[+-]\d+,)?Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
                my $aref=$EnterLeave{$ProcessThread};
                warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
                my $data={
@@ -1026,11 +1209,11 @@ while (<>) {
                        }
                next;
                }
-       elsif (my($ByteOffset,$Length)=
-                       /^WRITE: ByteOffset=($hex),Length=($hex)/) {
+       elsif (my($op,$ByteOffset,$Length)=
+                       /^(READ|WRITE): ByteOffset=($hex),Length=($hex)/) {
                my $aref=$EnterLeave{$ProcessThread};
                warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
-               $Object->{"WRITE"}={
+               $Object->{$op}={
                        "ByteOffset"=>$ByteOffset,
                        "Length"=>$Length,
                        };
@@ -1038,6 +1221,7 @@ while (<>) {
                }
 
        $LastLeave=${$LastLeave{$ProcessThread}}[$#{$LastLeave{$ProcessThread}}-1];
+       $EnterLeave=$EnterLeave{$ProcessThread};
 
        if (my($r)=
                        /^leave: IRP_MJ_\w+: r=($hex)/) {
@@ -1138,11 +1322,34 @@ while (<>) {
                next;
                }
 
+       if (/^leave: IRP_MJ_READ\b/) {
+               IRP_MJ_READ_leave;
+               next;
+               }
+
+       if (my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps)=
+               /^enter: CcPurgeCacheSection: SectionObjectPointer=($hex),->SharedCacheMap=($hex),FileOffset=($hex),Length=($hex),UninitializeCacheMaps=([01])/) {
+               CcPurgeCacheSection $SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length,$UninitializeCacheMaps;
+               next;
+               }
+
        if (/^leave: IRP_MJ_WRITE\b/) {
                IRP_MJ_WRITE_leave;
                next;
                }
 
+       if (my($SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length)=
+                       /^enter: CcFlushCache: SectionObjectPointer=($hex),->SharedCacheMap=($hex),FileOffset=($hex),Length=($hex)/) {
+               CcFlushCache $SectionObjectPointer,$SharedCacheMap,$FileOffset,$Length;
+               next;
+               }
+
+       if (my($Status,$Information)=
+                       /^leave: CcFlushCache: IoStatus->Status=($hex),IoStatus->Information=($hex)/) {
+               CcFlushCache_leave $Status,$Information;
+               next;
+               }
+
        if (my($r)=
                        /^leave: AcquireForLazyWrite: r=([01])/) {
                AcquireForLazyWrite_leave $r;