Rewritten to be SharedCacheMap based instead of FileObject based.
[captive.git] / src / TraceFS / checktrace.pl
index 1e397a5..7930d60 100755 (executable)
 use strict;
 use warnings;
 use Data::Dumper;
+use Carp qw(cluck confess);
 
 
 my $filter=0;
 $Data::Dumper::Sortkeys=1;
 my $ntfs_blocksize=0x200;
 
-# $Object{"by"}="CcSomeFunction";
-# $Object{"line_enter"}=123;
-# $Object{"line_leave"}=124;
-# $Object{"process_thread"}="0x12345678/0x12345678";
+# $Object->{"by"}="CcSomeFunction";
+# $Object->{"line_enter"}=123;
+# $Object->{"line_leave"}=124;
+# $Object->{"process_thread"}="0x12345678/0x12345678";
+# $Object->{"data"}[dataline]{"FileObject"}="0x12345678";
+# $Object->{"data"}[dataline]{"FileName"}="\filename" or undef() if NULL;
+# $Object->{"data"}[dataline]{"Flags"}="0x40100";
+# $Object->{"data"}[dataline]{"SectionObjectPointer"}="0x12345678";
+# $Object->{"data"}[dataline]{"SharedCacheMap"}="0x12345678";
 # $FileObject{$FileObject}{"FileObject"}="0x12345678";
-# $FileObject{$FileObject}{"Allocation"}="0x12345";
-# $FileObject{$FileObject}{"FileSize"}="0x12345";
-# $FileObject{$FileObject}{"map"}="0x12345678" (Bcb);
-# $FileObject{$FileObject}{"pin"}{"0x1000"}="0x12345678" (Bcb);
-# $FileObject{$FileObject}{"PinAccess"}=0 or 1;
+# $FileObject{$FileObject}{"SectionObjectPointer"}="0x12345678";
+# $SectionObjectPointer{$SectionObjectPointer}{"SectionObjectPointer"}="0x12345678";
+# $SectionObjectPointer{$SectionObjectPointer}{"SharedCacheMap"}="0x12345678";
+# $SharedCacheMap{$SharedCacheMap}{"SharedCacheMap"}="0x12345678";
+# $SharedCacheMap{$SharedCacheMap}{"SectionObjectPointer"}="0x12345678";
+# $SharedCacheMap{$SharedCacheMap}{"Allocation"}="0x12345";
+# $SharedCacheMap{$SharedCacheMap}{"FileSize"}="0x12345";
+# $SharedCacheMap{$SharedCacheMap}{"ref_count"}=1;
+# $SharedCacheMap{$SharedCacheMap}{"map"}="0x12345678" (Bcb);
+# $SharedCacheMap{$SharedCacheMap}{"pin"}{"0x1000"}="0x12345678" (Bcb);
+# $SharedCacheMap{$SharedCacheMap}{"PinAccess"}=0 or 1;
 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
-# $Bcb{$Bcb}{"FileObject"}="0x12345678";
+# $Bcb{$Bcb}{"SharedCacheMap"}="0x12345678";
 # $Bcb{$Bcb}{"type"}="pin" or "map";
-# $Bcb{$Bcb}{"ref_count"}=1
+# $Bcb{$Bcb}{"ref_count"}=1;
 # $Bcb{$Bcb}{"FileOffset"}="0x1000" if {"type"} eq "pin";
 # $Bcb{$Bcb}{"Buffer"}="0x12345678";   # PAGE_SIZE-aligned for "pin", FileOffset_0-aligned for "map"
 
 my %FileObject;
+my %SectionObjectPointer;
+my %SharedCacheMap;
 my %Bcb;
 
 END {
-       print Data::Dumper->Dump([\%FileObject,\%Bcb],[qw(%FileObject %Bcb)]) if !$filter;
+       print Data::Dumper->Dump([\%FileObject,\%SectionObjectPointer,\%SharedCacheMap,\%Bcb],
+                              [qw(%FileObject  %SectionObjectPointer  %SharedCacheMap  %Bcb)]) if !$filter;
        }
 
 my $Object;
@@ -60,69 +75,273 @@ my($num)=@_;
        return sprintf("0x%X",$num);
 }
 
+sub FObject($)
+{
+my($FileObject)=@_;
+
+       my $FObject=$FileObject{$FileObject};
+       if (!$FObject) {
+               my($package,$filename,$line,$subroutine)=caller 0;
+               warn "Non-existent FileObject $FileObject by line $line";
+               }
+       return $FObject;
+}
+
+sub SObject($)
+{
+my($SectionObjectPointer)=@_;
+
+       my $SObject=$SectionObjectPointer{$SectionObjectPointer};
+       if (!$SObject) {
+               my($package,$filename,$line,$subroutine)=caller 0;
+               warn "Non-existent SectionObjectPointer $SectionObjectPointer by line $line"
+               }
+       return $SObject;
+}
+
+sub SObject_from_FileObject($)
+{
+my($FileObject)=@_;
+
+       return if !(my $FObject=FObject $FileObject);
+       my $SObject=SObject $FObject->{"SectionObjectPointer"};
+       if (!$SObject) {
+               my($package,$filename,$line,$subroutine)=caller 0;
+               warn "by line $line";
+               }
+       return $SObject;
+}
+
+sub delete_CObject($)
+{
+my($CObject)=@_;
+
+       my $SharedCacheMap=$CObject->{"SharedCacheMap"};
+       do { warn "Trailing map $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for ($CObject->{"map"});
+       do { warn "Trailing pin $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for (values(%{$CObject->{"pin"}}));
+       delete $SharedCacheMap{$SharedCacheMap};
+}
+
+sub CObject($)
+{
+my($SharedCacheMap)=@_;
+
+       my $CObject=$SharedCacheMap{$SharedCacheMap};
+       if (!$CObject) {
+               my($package,$filename,$line,$subroutine)=caller 0;
+               warn "Non-existent SharedCacheMap $SharedCacheMap by line $line";
+               }
+       return $CObject;
+}
+
+sub CObject_from_FileObject($)
+{
+my($FileObject)=@_;
+
+       return if !(my $SObject=SObject_from_FileObject $FileObject);
+       return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
+       return $CObject;
+}
+
+sub SharedCacheMap_valid($)
+{
+my($SharedCacheMap)=@_;
+
+       cluck if !defined $SharedCacheMap;
+       return 0 if "0x".("F"x8) eq $SharedCacheMap;
+       return 0 if !eval $SharedCacheMap;
+       return 1;
+}
+
+sub check_data($)
+{
+my($data)=@_;
+
+       if (!eval $data->{"SectionObjectPointer"}) {
+               return if $Object->{"by"} eq "IRP_MJ_CREATE";   # SectionObjectPointer is not yet initialized
+               warn "Existing FileObject ".$data->{"FileObject"}." but no SectionObjectPointer found"
+                               if $FileObject{$data->{"FileObject"}} && eval($FileObject{$data->{"FileObject"}}{"SectionObjectPointer"});
+               return;
+               }
+       my $SectionObjectPointer=$data->{"SectionObjectPointer"};
+       if (!SharedCacheMap_valid $data->{"SharedCacheMap"} && $SectionObjectPointer{$SectionObjectPointer}) {
+               return if !(my $SObject=SObject $SectionObjectPointer);
+               my $SharedCacheMap=$SObject->{"SharedCacheMap"};
+               return if !eval $SharedCacheMap;
+               my $CObject=CObject $SharedCacheMap;
+               warn "Existing SectionObjectPointer ".$data->{"SectionObjectPointer"}." but no SharedCacheMap found,"
+                                               ." ref_count of SharedCacheMap is ".$CObject->{"ref_count"}
+                               if $CObject->{"ref_count"};
+#                              if $SectionObjectPointer{$data->{"SectionObjectPointer"}};
+               # SharedCacheMap was droppped by async task as it had ref_count==0.
+               delete_CObject $CObject;
+               $SObject->{"SharedCacheMap"}=tohex(0);
+               # FileObject is still valid!
+               return;
+               }
+       return if !$FileObject{$data->{"FileObject"}};
+       return if !(my $FObject=FObject $data->{"FileObject"});
+       return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
+       my $SharedCacheMap=$SObject->{"SharedCacheMap"};
+       warn "FileObject ".$FObject->{"FileObject"}." SectionObjectPointer ".$SObject->{"SectionObjectPointer"}
+                                       ." expected SharedCacheMap $SharedCacheMap"
+                                       ." but found SharedCacheMap ".$data->{"SharedCacheMap"}
+                       if $SharedCacheMap ne $data->{"SharedCacheMap"};
+       warn "INTERNAL: SharedCacheMap $SharedCacheMap of FileObject ".$FObject->{"FileObject"}." got destroyed"
+                       if !$SharedCacheMap{$SharedCacheMap};
+}
+
 sub CcInitializeCacheMap($$$$$)
 {
 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=@_;
 
        $ValidDataLength=$FileSize if $ValidDataLength==eval("0x".("F"x8));
-       if ($FileObject{$FileObject}) {
-#              warn "FileObject $FileObject registered twice";
-               return if !(my $FObject=FObject($FileObject));
-               delete_FObject($FObject);
-               }
-       $FileObject{$FileObject}=$Object;
-       $Object->{"FileObject"}=$FileObject;
+       $Object->{"ref_count"}=1;
        $Object->{"AllocationSize"}=tohex($AllocationSize);
        $Object->{"FileSize"}=tohex($FileSize);
+       $Object->{"ValidDataLength"}=tohex($ValidDataLength);
        $Object->{"map"}=undef();
        $Object->{"pin"}={};
        $Object->{"PinAccess"}=$PinAccess;
-       CcSetFileSizes($FileObject,$AllocationSize,$FileSize,$ValidDataLength);
+       $Object->{"FileObject"}=$FileObject;
 }
 
-sub FObject($)
+sub CcInitializeCacheMap_leave()
 {
-my($FileObject)=@_;
+       my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
+       $Object->{"SharedCacheMap"}=$SharedCacheMap;
+       my $old=$SharedCacheMap{$SharedCacheMap};
+       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);
+               $old=undef();
+               }
+       if (!$old != !SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
+               warn "Expecting old SharedCacheMap validity ".(!!$old)
+                               ." but found old SharedCacheMap ".$Object->{"data"}[0]{"SharedCacheMap"};
+               }
+       warn "New SharedCacheMap ".$Object->{"data"}[1]{"SharedCacheMap"}." is not valid"
+                       if !SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"};
+       if (SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
+               warn "Existing SharedCacheMap changed"
+                                               ." from ".$Object->{"data"}[0]{"SharedCacheMap"}." to ".$Object->{"data"}[1]{"SharedCacheMap"}
+                               if $Object->{"data"}[0]{"SharedCacheMap"} ne $Object->{"data"}[1]{"SharedCacheMap"};
+               }
+       if ($old) {
+               for my $field (qw(AllocationSize FileSize PinAccess)) {
+                       warn "SharedCacheMap $SharedCacheMap old instance $field ".$old->{$field}
+                                                       ." != new instance $field ".$Object->{$field}
+                                       if $old->{$field} ne $Object->{$field};
+                       }
+               do { warn "Existing map Bcb $_ during CcInitializeCacheMap()" if $_; } for ($old->{"map"});
+               do { warn "Existing pin Bcb $_ during CcInitializeCacheMap()" if $_; } for (values(%{$old->{"pin"}}));
+               $Object->{"ref_count"}+=$old->{"ref_count"};
+               }
+       $SharedCacheMap{$SharedCacheMap}=$Object;
+
+       warn "Changed SectionObjectPointer inside CcInitializeCacheMap()"
+                                       ." from ".$Object->{"data"}[0]{"SectionObjectPointer"}." to ".$Object->{"data"}[1]{"SectionObjectPointer"}
+                       if $Object->{"data"}[0]{"SectionObjectPointer"} ne $Object->{"data"}[1]{"SectionObjectPointer"};
+       my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
+
+       my $FileObject=$Object->{"FileObject"};
+       if (my $FObject=$FileObject{$FileObject}) {
+               if (my $SObject=$SectionObjectPointer{$FObject->{"SectionObjectPointer"}}) {
+                       warn "Changed SectionObjectPointer of FileObject $FileObject"
+                                                       ." from ".$FObject->{"SectionObjectPointer"}." to ".$SectionObjectPointer
+                                       if $FObject->{"SectionObjectPointer"} ne $SectionObjectPointer;
+                       }
+               # Otherwise SectionObjectPointer could be deleted and rebuilt async in the meantime.
+               }
+       $FileObject{$FileObject}={
+                       "FileObject"=>$FileObject,
+                       "SectionObjectPointer"=>$SectionObjectPointer,
+                       };
 
-       my $FObject=$FileObject{$FileObject};
-       warn "Non-existent FileObject $FileObject" if !$FObject;
-       return $FObject;
+       if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
+               warn "Changed SharedCacheMap of SectionObjectPointer $SectionObjectPointer"
+                                               ." from ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
+                               if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && eval($SObject->{"SharedCacheMap"});
+               }
+       $SectionObjectPointer{$SectionObjectPointer}={
+                       "SectionObjectPointer"=>$SectionObjectPointer,
+                       "SharedCacheMap"=>$SharedCacheMap,
+                       };
+
+       CcSetFileSizes($FileObject,map({ eval($Object->{$_}); } qw(AllocationSize FileSize ValidDataLength)));
+       delete $Object->{$_} for (qw(FileObject ValidDataLength));
 }
 
-sub delete_FObject($)
+sub CcUninitializeCacheMap($$)
 {
-my($FObject)=@_;
+my($FileObject,$TruncateSize)=@_;
 
-       my $FileObject=$FObject->{"FileObject"};
-       do { warn "Trailing map $_ of FileObject $FileObject during its deletion" if $_; } for ($FObject->{"map"});
-       do { warn "Trailing pin $_ of FileObject $FileObject during its deletion" if $_; } for (values(%{$FObject->{"pin"}}));
-       delete $FileObject{$FileObject};
+       $Object->{"FileObject"}=$FileObject;
 }
 
-sub CcUninitializeCacheMap($$)
+sub CcUninitializeCacheMap_leave($)
 {
-my($FileObject,$TruncateSize)=@_;
+my($r)=@_;
 
-       # CcUninitializeCacheMap() w/o CcInitializeCacheMap() is allowed:
-       return if !$FileObject{$FileObject};
+       my $FileObject=$Object->{"FileObject"};
+       # 'r' means function success.
+       # r=0 either if no CcInitializeCacheMap() was called at all
+       # or if Cc was unable to detach SharedCacheMap and it remains valid
+       # (FIXME: Do we SharedCacheMap->ref_count-- on in such case?).
+       my $SectionObjectPointer=$FileObject{$FileObject}->{"SectionObjectPointer"} if $FileObject{$FileObject};
+       my $SharedCacheMap=$SectionObjectPointer{$SectionObjectPointer}->{"SharedCacheMap"}
+                       if $SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer};
+       warn "Unexpected 'r' result $r for CcUninitializeCacheMap of FileObject $FileObject"
+                       if !(eval($SharedCacheMap) && !SharedCacheMap_valid($Object->{"data"}[1]{"SharedCacheMap"})) != !$r;
+       if (!eval $SharedCacheMap) {
+               for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"},$Object->{"data"}[1]{"SharedCacheMap"}) {
+                       warn "Not expecting valid SharedCacheMap $SharedCacheMap"
+                                       if SharedCacheMap_valid $SharedCacheMap;
+                       }
+               return;
+               }
+       for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"}) {
+               warn "Expecting valid SharedCacheMap $SharedCacheMap"
+                               if !SharedCacheMap_valid $SharedCacheMap;
+               }
        return if !(my $FObject=FObject $FileObject);
-       delete_FObject $FObject;
+       return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
+       return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
+       if (--$CObject->{"ref_count"}) {
+               for my $SharedCacheMap ($Object->{"data"}[1]{"SharedCacheMap"}) {
+                       warn "Expecting still valid SharedCacheMap $SharedCacheMap after CcUninitializeCacheMap()"
+                                                       ." with ref_count=".$CObject->{"ref_count"}
+                                       if !SharedCacheMap_valid $SharedCacheMap;
+                       }
+               return;
+               }
+       if (!SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"}) {
+               delete_CObject $CObject;
+               $SObject->{"SharedCacheMap"}=tohex(0);
+               # FileObject is still valid!
+               }
+       else {
+               # FIXME: Do we SharedCacheMap->ref_count-- on in such case?
+               }
 }
 
 sub CcSetFileSizes($$$$)
 {
 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
 
-       return if !(my $FObject=FObject $FileObject);
-       if ($AllocationSize!=eval($FObject->{"AllocationSize"})) {
-               do { warn "Existing map $_ of FileObject $FileObject during CcSetAllocationSizes(),"
-                                               ." AllocationSize=".$FObject->{"AllocationSize"} if $_; }
-                               for ($FObject->{"map"});
-               do { warn "Existing pin $_ of FileObject $FileObject during CcSetAllocationSizes(),"
-                                               ." AllocationSize=".$FObject->{"AllocationSize"} if $_; }
-                               for (values(%{$FObject->{"pin"}}));
-               }
-       # $ValidDataLength can be > $FObject->{"FileSize"};
+       return if !(my $CObject=CObject_from_FileObject $FileObject);
+       my $SharedCacheMap=$CObject->{"SharedCacheMap"};
+       if ($AllocationSize!=eval($CObject->{"AllocationSize"})) {
+               do { warn "Existing map $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
+                                               ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
+                               for ($CObject->{"map"});
+               do { warn "Existing pin $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
+                                               ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
+                               for (values(%{$CObject->{"pin"}}));
+               }
+       # $ValidDataLength can be > $CObject->{"FileSize"};
        warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
                        if $ValidDataLength>$FileSize;
        warn "0 != AllocationSize ".tohex($AllocationSize)." % ntfs_blocksize ".tohex($ntfs_blocksize)
@@ -130,8 +349,35 @@ my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
        # $AllocationSize can be higher
        warn "FileSize ".tohex($FileSize)." > AllocationSize ".tohex($AllocationSize)
                        if $FileSize>$AllocationSize;
-       $FObject->{"FileSize"}=tohex($FileSize);
-       $FObject->{"AllocationSize"}=tohex($AllocationSize);
+       $CObject->{"FileSize"}=tohex($FileSize);
+       $CObject->{"AllocationSize"}=tohex($AllocationSize);
+}
+
+sub IRP_MJ_CREATE_leave()
+{
+       do { warn "Non-NULL SectionObjectPointer $_ not expected" if eval($_); } for ($Object->{"data"}[0]{"SectionObjectPointer"});
+       my $FileObject=$Object->{"data"}[0]{"FileObject"};
+       warn "Existing FileObject $FileObject not expected" if $FileObject{$FileObject};
+       my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
+       # We want to track even FileObject without SectionObjectPointer yet.
+#      if ($SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer})
+       {
+               $FileObject{$FileObject}={
+                               "FileObject"=>$FileObject,
+                               "SectionObjectPointer"=>$SectionObjectPointer,
+                               };
+               }
+       if (eval $SectionObjectPointer) {
+               my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
+               if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
+                       warn "Changed SharedCacheMap from stored ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
+                                       if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && $Object->{"by"} ne "IRP_MJ_CREATE";
+                       }
+               $SectionObjectPointer{$SectionObjectPointer}={
+                               "SectionObjectPointer"=>$SectionObjectPointer,
+                               "SharedCacheMap"=>$SharedCacheMap,
+                               };
+               }
 }
 
 sub BObject($)
@@ -145,20 +391,20 @@ my($Bcb)=@_;
 
 sub Bcb_conflict($;@)
 {
-my($FObject,@Bcb_list)=@_;
+my($CObject,@Bcb_list)=@_;
 
        my $arg=0;
        my %check=(
-               "map"=>$FObject->{"map"},
+               "map"=>$CObject->{"map"},
                map(("arg".($arg++)=>$_),@Bcb_list),
-               %{$FObject->{"pin"}},
+               %{$CObject->{"pin"}},
                );
        my %reversed;
        my $BufferBase; # relativized to FileOffset 0
        my $BufferBase_val;
        while (my($key,$val)=each(%check)) {
                next if !defined $val;
-               warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of FileObject ".$FObject->{"FileObject"}
+               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.
@@ -180,7 +426,7 @@ sub Bcb_checkref($$)
 {
 my($BObject,$ref)=@_;
 
-       return if !(my $FObject=FObject $BObject->{"FileObject"});
+       return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
        my $type=$BObject->{"type"};
        my $Bcb=$BObject->{"Bcb"};
        if ($$ref) {
@@ -197,20 +443,20 @@ my($BObject,$ref)=@_;
                $$ref=undef();
                }
        $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
-       Bcb_conflict $FObject,$Bcb;
+       Bcb_conflict $CObject,$Bcb;
        $$ref=$Bcb;
 }
 
 sub map_new($;$$)
 {
-my($FileObject,$FileOffset,$Length)=@_;
+my($SharedCacheMap,$FileOffset,$Length)=@_;
 
-       return if !(my $FObject=FObject $FileObject);
+       return if !(my $CObject=CObject $SharedCacheMap);
        if (defined($FileOffset) && defined($Length)) {
-               warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$FObject->{"FileSize"}
-                               if $FileOffset+$Length>eval($FObject->{"FileSize"});
+               warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
+                               if $FileOffset+$Length>eval($CObject->{"FileSize"});
                }
-       $Object->{"FileObject"}=$FileObject;
+       $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
        if (defined $FileOffset) {
                $Object->{"FileOffset"}=tohex($FileOffset);
                }
@@ -218,19 +464,27 @@ my($FileObject,$FileOffset,$Length)=@_;
        $Object->{"ref_count"}=1;
 }
 
+sub map_new_from_FileObject($;$$)
+{
+my($FileObject,$FileOffset,$Length)=@_;
+
+       return if !(my $CObject=CObject_from_FileObject $FileObject);
+       map_new $CObject->{"SharedCacheMap"},$FileOffset,$Length;
+}
+
 sub map_new_leave($;$)
 {
 my($Bcb,$Buffer)=@_;
 
        $Object->{"Bcb"}=$Bcb;
-       return if !(my $FObject=FObject $Object->{"FileObject"});
+       return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 
        if (defined $Buffer) {
                $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
                }
        delete $Object->{"FileOffset"};
 
-       my $ref=\$FObject->{"map"};
+       my $ref=\$CObject->{"map"};
        Bcb_checkref $Object,$ref;
 }
 
@@ -238,7 +492,7 @@ sub CcMapData($$$)
 {
 my($FileObject,$FileOffset,$Length)=@_;
 
-       map_new $FileObject,$FileOffset,$Length;
+       map_new_from_FileObject $FileObject,$FileOffset,$Length;
 }
 
 sub CcMapData_leave($$)
@@ -252,14 +506,14 @@ sub pin_new($$$)
 {
 my($FileObject,$FileOffset,$Length)=@_;
 
-       return if !(my $FObject=FObject $FileObject);
-       warn "Pinning of non-PinAccess FileObject $FileObject" if !$FObject->{"PinAccess"};
-       warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$FObject->{"FileSize"}
-                       if $FileOffset+$Length>eval($FObject->{"FileSize"});
+       return if !(my $CObject=CObject_from_FileObject $FileObject);
+       warn "Pinning of non-PinAccess FileObject $FileObject" if !$CObject->{"PinAccess"};
+       warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
+                       if $FileOffset+$Length>eval($CObject->{"FileSize"});
        warn "Pinning Length ".tohex($Length)." > 0x1000" if $Length>0x1000;
        warn "Pinning across file page (start=".tohex($FileOffset).",end-1=".tohex($FileOffset+$Length-1).")"
                        if ($FileOffset&~0xFFF)!=(($FileOffset+$Length-1)&~0xFFF);
-       $Object->{"FileObject"}=$FileObject;
+       $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
        $Object->{"FileOffset"}=tohex($FileOffset);
        $Object->{"type"}="pin";
        $Object->{"ref_count"}=1;
@@ -270,13 +524,13 @@ sub pin_new_leave($$)
 my($Bcb,$Buffer)=@_;
 
        $Object->{"Bcb"}=$Bcb;
-       return if !(my $FObject=FObject $Object->{"FileObject"});
+       return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
        $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"})&0xFFF));
        my $shift=eval($Object->{"FileOffset"})&0xFFF;
        $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
        $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 
-       my $ref=\$FObject->{"pin"}{$Object->{"FileOffset"}};
+       my $ref=\$CObject->{"pin"}{$Object->{"FileOffset"}};
        Bcb_checkref $Object,$ref;
 }
 
@@ -319,13 +573,13 @@ sub CcPinMappedData_leave($)
 {
 my($Bcb)=@_;
 
-       return if !(my $FObject=FObject $Object->{"FileObject"});
-       do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed FileObject ".$Object->{"FileObject"}; return; }
-                       if !(my $mapBcb=$FObject->{"map"});
+       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"}));
 
-       my $Bcb2=$FObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
+       my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
        my $BObject2=BObject $Bcb2 if $Bcb2;
        if ($BObject2 && $BObject2->{"CcPinMappedData_double"}
                        && eval($BObject2->{"CcPinMappedData_double"})==eval($Object->{"FileOffset"})) {        # unaligned yet
@@ -338,7 +592,9 @@ my($Bcb)=@_;
                return;
                }
 
-       $Object->{"CcPinMappedData_double"}=$Object->{"FileOffset"};    # unaligned yet
+       # It appears as this cludge is not needed:
+#      $Object->{"CcPinMappedData_double"}=$Object->{"FileOffset"};    # unaligned yet
+
        pin_new_leave $Bcb,$Buffer;
 #      print STDERR "$.:".Dumper($Object);
 }
@@ -356,7 +612,7 @@ sub CcRemapBcb($)
 my($Bcb)=@_;
 
        return if !(my $BObject=BObject $Bcb);
-       map_new $BObject->{"FileObject"};
+       map_new $BObject->{"SharedCacheMap"};
        $Object->{"Buffer"}=tohex(eval($BObject->{"Buffer"})-eval($BObject->{"FileOffset"} || 0));
 }
 
@@ -374,20 +630,20 @@ my($Bcb)=@_;
        return if !(my $BObject=BObject $Bcb);
        delete $BObject->{"CcPinMappedData_double"};
        return if --$BObject->{"ref_count"};
-       return if !(my $FObject=FObject $BObject->{"FileObject"});
+       return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
        if ($BObject->{"type"} eq "map") {
-               for my $pin (values(%{$FObject->{"pin"}})) {
+               for my $pin (values(%{$CObject->{"pin"}})) {
                        warn "unpin map but CcPinMappedData pin $pin still exists"
                                        if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
                        }
                }
-       for my $ref ($BObject->{"type"} eq "map" ? \$FObject->{"map"} : \$FObject->{"pin"}{$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 FileObject ".$FObject->{"FileObject"}." ref ".($$ref || "<undef>")
+                                               ." in SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref ".($$ref || "<undef>")
                                if !defined($BObject->{"OwnerPointer"}) && !($$ref && $$ref eq $Bcb);
                if ($$ref && $$ref eq $Bcb) {
                        $$ref=undef();
-                       delete $FObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
+                       delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
                        }
                }
        delete $Bcb{$Bcb};
@@ -413,22 +669,32 @@ my($Bcb,$OwnerPointer)=@_;
 
        return if !(my $BObject=BObject $Bcb);
        warn "CcSetBcbOwnerPointer() on map Bcb $Bcb" if $BObject->{"type"} ne "pin";
-       return if !(my $FObject=FObject $BObject->{"FileObject"});
+       return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
        warn "Double CcSetBcbOwnerPointer() on Bcb $Bcb" if defined $BObject->{"OwnerPointer"};
-       my $val=$FObject->{"pin"}{$BObject->{"FileOffset"}};
+       my $val=$CObject->{"pin"}{$BObject->{"FileOffset"}};
        warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
-       delete $FObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
+       delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
        $BObject->{"OwnerPointer"}=$OwnerPointer;
 }
 
-sub IRP_MJ_CLOSE($)
+sub IRP_MJ_CLOSE_leave()
 {
-my($FileObject)=@_;
-
-       return if !$FileObject{$FileObject};
+       my $FileObject=$Object->{"data"}[0]{"FileObject"};
+#      # IRP_MJ_CLOSE of FileObject w/o CcInitializeCacheMap()?
+#      return if !$FileObject{$FileObject};
        return if !(my $FObject=FObject $FileObject);
-       warn "CcUnpinData() not called for FileObject $FileObject before IRP_MJ_CLOSE";
-       delete_FObject $FObject;
+       if (eval(my $SectionObjectPointer=$FObject->{"SectionObjectPointer"})) {
+               return if !(my $SObject=SObject $SectionObjectPointer);
+               my $SharedCacheMap=$SObject->{"SharedCacheMap"};
+               if (eval $SharedCacheMap) {
+                       return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
+                       # SharedCacheMap may still exist for FCB although this FileObject gets destroyed now.
+#                      warn "SectionObjectPointer $SectionObjectPointer still exists during IRP_MJ_CLOSE"
+#                                                      ." while SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref_count ".$CObject->{"ref_count"}
+#                                      if $SectionObjectPointer && $CObject->{"ref_count"};
+                       }
+               }
+       delete $FileObject{$FileObject};
 }
 
 
@@ -440,7 +706,8 @@ while (<>) {
        chomp;
        s/\r$//;
        # We may get some foreign garbage without '\n' before our debug data line:
-       s#^.*?\bTraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
+       # Do not use '\bTraceFS' as there really can be precediny _any_ data.
+       s#^.*?TraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
        my($process_thread)=($1);
 
        $Object=undef();
@@ -451,23 +718,98 @@ while (<>) {
                $Object->{"process_thread"}=$process_thread;
                push @{$enter_leave{$process_thread}},$Object;
                }
-       if (/^leave: (\w+)/) {
+       elsif (/^leave: (\w+)/) {
                warn "Empty pop stack during 'leave' of $1" if !($Object=pop @{$enter_leave{$process_thread}});
                warn "Non-matching popped 'by' ".$Object->{"by"}." ne current 'leave' $1"
                                if $Object->{"by"} ne $1;
                $Object->{"line_leave"}=$.;
                }
+       elsif (my($FileObject,$FileName,$Flags,$SectionObjectPointer,$SharedCacheMap)=
+                       /^FileObject=($hex): FileName=(?:NULL|'(.*)'),Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
+               my $aref=$enter_leave{$process_thread};
+               warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
+               my $data={
+                               "FileObject"=>$FileObject,
+                               "FileName"=>$FileName,
+                               "Flags"=>$Flags,
+                               "SectionObjectPointer"=>$SectionObjectPointer,
+                               "SharedCacheMap"=>$SharedCacheMap,
+                               "line"=>$.,
+                               };
+               push @{$Object->{"data"}},$data;
+               my $isinit={ map(($_=>1),qw(
+                               CcInitializeCacheMap
+                               CcUninitializeCacheMap
+                               IRP_MJ_CREATE
+                               )) }->{$Object->{"by"}};
+               check_data $data
+                               if 1==@{$Object->{"data"}} || !$isinit;
+               if ($isinit) {
+                       # Prevent 'SharedCacheMap' 0->N change by CcInitializeCacheMap() called inside.
+                       for my $ref (@$aref[0..$#$aref-1]) {
+                               $ref->{"data"}[0]->{"SharedCacheMap"}=$SharedCacheMap;
+                               }
+                       }
+               if (2<=@{$Object->{"data"}}) {
+                       my $data_prev=$Object->{"data"}[$#{$Object->{"data"}}-1];
+                       for my $field (qw(FileObject FileName Flags),($isinit ? () : qw(SharedCacheMap))) {
+                               next if !defined(my $prev=$data_prev->{$field});
+                               next if !defined(my $now=$data->{$field});
+                               my $by=$Object->{"by"};
+                               if ($field eq "Flags") {
+                                       next if $by eq "IRP_MJ_CREATE" && $field eq "Flags";
+                                       my $FO_CLEANUP_COMPLETE=0x4000;
+                                       $now=tohex(eval($now)&~$FO_CLEANUP_COMPLETE) if $by eq "IRP_MJ_CLEANUP";
+                                       my $FO_FILE_FAST_IO_READ=0x80000;
+                                       $prev=tohex(eval($prev)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_CLEANUP";
+                                       $now=tohex(eval($now)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_READ" && !(eval($prev)&$FO_FILE_FAST_IO_READ);
+                                       my $FO_FILE_MODIFIED=0x1000;
+                                       $now=tohex(eval($now)&~$FO_FILE_MODIFIED) if $by eq "IRP_MJ_WRITE" && !(eval($prev)&$FO_FILE_MODIFIED);
+                                       my $FO_FILE_SIZE_CHANGED=0x2000;
+                                       $prev=tohex(eval($prev)&~$FO_FILE_MODIFIED)
+                                                       if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_MODIFIED);
+                                       $prev=tohex(eval($prev)&~$FO_FILE_SIZE_CHANGED)
+                                                       if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_SIZE_CHANGED);
+                                       }
+                               next if $by eq "IRP_MJ_CLOSE" && $field eq "FileName";
+                               $prev=~s#\\$## if $by eq "IRP_MJ_CREATE";
+                               $prev="\\" if $by eq "IRP_MJ_CREATE" && $prev eq "";
+                               $prev=~s#:.*## if $by eq "IRP_MJ_CREATE" && $prev ne $now;
+                               next if $field eq "SharedCacheMap" && !SharedCacheMap_valid $prev && !SharedCacheMap_valid $now;
+                               do { warn "Changed data field $field, prev=".$data_prev->{$field}.", now=".$data->{$field}." by $by";
+#                                              print STDERR Dumper $data_prev,$data;
+                                               } if $prev ne $now;
+                               }
+                       }
+               next;
+               }
+
+       if (my($r)=
+                       /^leave: IRP_MJ_\w+: r=($hex)/) {
+               # Failed requests should make no consequences.
+               next if eval($r);
+               }
 
        if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=
                        /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
                CcInitializeCacheMap $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength),eval($PinAccess);
                next;
                }
+       if (/^leave: CcInitializeCacheMap\b/) {
+               CcInitializeCacheMap_leave;
+               next;
+               }
+
        if (my($FileObject,$TruncateSize)=
                        /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
                CcUninitializeCacheMap $FileObject,eval($TruncateSize);
                next;
                }
+       if (my($r)=
+                       /^leave: CcUninitializeCacheMap: r=([01])/) {
+               CcUninitializeCacheMap_leave $r;
+               next;
+               }
 
        if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
                        /^enter: CcSetFileSizes: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex)/) {
@@ -475,6 +817,16 @@ while (<>) {
                next;
                }
 
+       if (/^leave: IRP_MJ_CREATE\b/) {
+               IRP_MJ_CREATE_leave;
+               next;
+               }
+
+       if (/^leave: IRP_MJ_CLOSE\b/) {
+               IRP_MJ_CLOSE_leave;
+               next;
+               }
+
        if (my($FileObject,$FileOffset,$Length)=
                        /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
                CcMapData $FileObject,eval($FileOffset),eval($Length);
@@ -553,32 +905,9 @@ while (<>) {
                next;
                }
 
-       if (my($irp_mj)=
-                       /^enter: (IRP_MJ_\w+)/) {
-               push @{$last_irp_mj{$process_thread}},$irp_mj;
-               next;
-               }
-       if (my($irp_mj)=
-                       /^leave: (IRP_MJ_\w+)/) {
-               my $irp_mj_last=pop @{$last_irp_mj{$process_thread}};
-               warn "Non-matching popped IRP name irp_mj $irp_mj ne irp_mj_last $irp_mj_last"
-                               if $irp_mj ne $irp_mj_last;
-               next;
-               }
-
-       if (my($FileObject)=
-                       /^FileObject=($hex):/) {
-               my $aref=$last_irp_mj{$process_thread};
-               my $irp_mj_last=${$aref}[$#$aref];
-               next if !$irp_mj_last || $irp_mj_last ne "IRP_MJ_CLOSE";
-               IRP_MJ_CLOSE $FileObject;
-               next;
-               }
-
        print "$_\n" if $filter;
        }
 for my $FileObject (keys(%FileObject)) {
        warn "EXIT: still CcInitializeCacheMap FileObject $FileObject";
        next if !(my $FObject=FObject $FileObject);
-       delete_FObject $FObject;
        }