+ # Do not: warn "Lsn already set for Bcb $Bcb as ".$BObject->{"Lsn"}." while current Lsn=$Lsn" if $BObject->{"Lsn"};
+ # as it is permitted.
+ warn "Lsn goes backward for Bcb $Bcb old Lsn ".$BObject->{"Lsn"}." to a new Lsn=$Lsn"
+ if $BObject->{"Lsn"} && eval($BObject->{"Lsn"})>eval($Lsn);
+ $BObject->{"Lsn"}=$Lsn if $Lsn ne "0x".("F"x8);
+ $BObject->{"dirty"}=1;
+ return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
+}
+
+sub FlushToLsnRoutine($$)
+{
+my($LogHandle,$Lsn)=@_;
+
+ $Object->{"LogHandle"}=$LogHandle;
+ $Object->{"Lsn"}=$Lsn;
+
+ my $obj=${$EnterLeave}[$#$EnterLeave-1];
+ warn "FLUSH" if $obj->{"by"} eq "CcFlushCache";
+}
+
+my $LogHandle_static;
+sub CcSetLogHandleForFile($$$)
+{
+my($FileObject,$LogHandle,$FlushToLsnRoutine)=@_;
+
+ return if !(my $CObject=CObject_from_FileObject $FileObject);
+ warn "LogHandle ".$CObject->{"LogHandle"}." already exists for SharedCacheMap ".$CObject->{"SharedCacheMap"}
+ if $CObject->{"LogHandle"};
+ return if !eval $LogHandle; # $LogHandle may be "0x0"
+ # ntfs.sys uses single LogHandle for its whole session:
+ warn "Non-unique LogHandle $LogHandle while last LogHandle was $LogHandle_static"
+ if $LogHandle_static && $LogHandle ne $LogHandle_static;
+ $CObject->{"LogHandle"}=$LogHandle;
+ if (!$LogHandle{$LogHandle}) {
+ $LogHandle{$LogHandle}={
+ "LogHandle"=>$LogHandle,
+ };
+ }
+}
+
+sub IRP_MJ_WRITE_leave_page($$)
+{
+my($ByteOffset,$Lsn_check)=@_;
+
+ my $SharedCacheMap=$Object->{"data"}[0]{"SharedCacheMap"};
+ return if !(my $CObject=CObject $SharedCacheMap);
+ my $FlushToLsnRoutine=$LastLeave if $LastLeave->{"by"} eq "FlushToLsnRoutine";
+ # Do not: my $Bcb=$CObject->{"pin"}{$ByteOffset};
+ # as Bcbs with $BObject->{"OwnerPointer"} are no longer stored in $CObject->{"pin"}.
+ my @Bcbs;
+ for my $Bcb (keys(%Bcb)) {
+ my $BObject=BObject $Bcb;
+ if (1
+ && $BObject->{"type"} eq "pin"
+ && $BObject->{"SharedCacheMap"} eq $SharedCacheMap
+ && $BObject->{"FileOffset"} eq $ByteOffset) {
+ push @Bcbs,$Bcb;
+ }
+ }
+ if (!@Bcbs) {
+ do {
+ 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 && !(${$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;
+ my $Bcb=$Bcbs[0];
+ return if !(my $BObject=BObject $Bcb);
+ warn "IRP_MJ_WRITE on non-dirty Bcb $Bcb" if !$BObject->{"dirty"};
+ if ($FlushToLsnRoutine) {
+ push @$Lsn_check,{
+ "Bcb"=>$Bcb,
+ "Bcb_Lsn",$BObject->{"Lsn"},
+ } if $Lsn_check;
+ }
+ else {
+ 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 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) {
+ IRP_MJ_WRITE_leave_page tohex(eval($Object->{"WRITE"}{"ByteOffset"})+0x1000*$reloffs),\@Lsn_check;
+ }
+
+ if ($LastLeave->{"by"} eq "FlushToLsnRoutine" && (my $FlushToLsnRoutine=$LastLeave)) {
+ my $Lsn_max;
+ for (@Lsn_check) {
+ my $Lsn=eval $_->{"Bcb_Lsn"};
+ $Lsn_max=$Lsn if !defined($Lsn_max) || $Lsn_max<$Lsn;
+ }
+ warn "FlushToLsnRoutine of line_enter ".$FlushToLsnRoutine->{"line_enter"}
+ ." got Lsn ".$FlushToLsnRoutine->{"Lsn"}." although Bcbs have "
+ .join(",",map({ "(".$_->{"Bcb"}.":".$_->{"Bcb_Lsn"}.")"; } @Lsn_check))
+ if tohex($Lsn_max) ne $FlushToLsnRoutine->{"Lsn"};
+ }
+}
+
+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)=@_;
+
+ $Object->{"FileObject"}=$FileObject;
+ warn "FileOffset $FileOffset not divisible by 0x1000" if eval($FileOffset)%0x1000;
+ $Object->{"FileOffset"}=$FileOffset;
+ warn "Length $Length not divisible by 0x1000" if eval($Length)%0x1000;
+ $Object->{"Length"}=$Length;
+}
+
+sub CcPrepareMdlWrite_leave($$$)
+{
+my($MdlChain,$Status,$Information)=@_;
+
+ do { warn "Unexpected Status $Status"; return; } if eval $Status;
+ warn "Unexpected Information $Information" if $Information ne $Object->{"Length"};
+ warn "MdlChain $MdlChain already exists" if $MdlChain{$MdlChain};
+ $MdlChain{$MdlChain}=$Object;
+}
+
+sub CcMdlWriteComplete($$$)
+{
+my($FileObject,$FileOffset,$MdlChain)=@_;
+
+ return if !(my $MObject=MObject $MdlChain);
+ warn "CcMdlWriteComplete() parameter FileObject $FileObject"
+ ." not matching MdlChain $MdlChain FileObject ".$MObject->{"FileObject"}
+ if $FileObject ne $MObject->{"FileObject"};
+ warn "CcMdlWriteComplete() parameter FileOffset $FileOffset"
+ ." not matching MdlChain $MdlChain FileOffset ".$MObject->{"FileOffset"}
+ if $FileOffset ne $MObject->{"FileOffset"};
+ # Propose MdlChain to a simulated Bcb.
+ # We must split it by pages as pin can be just 0x1000 sized.
+ return if !(my $CObject=CObject_from_FileObject $MObject->{"FileObject"});
+ for my $reloffs (0..eval($MObject->{"Length"})/0x1000-1) {
+ my $BObject={ %$MObject };
+ $BObject->{"Bcb"}="MdlChain $MdlChain reloffs $reloffs";
+ $BObject->{"FileOffset"}=tohex(eval($MObject->{"FileOffset"})+$reloffs*0x1000);
+ $BObject->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
+ $BObject->{"type"}="pin";
+ $BObject->{"ref_count"}=0;
+ $BObject->{"dirty"}=1;
+ warn "Bcb ".$BObject->{"Bcb"}." already exists" if $Bcb{$BObject->{"Bcb"}};
+ $Bcb{$BObject->{"Bcb"}}=$BObject;
+ }
+ delete $MdlChain{$MdlChain};
+}
+
+sub CcMdlWriteAbort($$)
+{
+my($FileObject,$MdlChain)=@_;
+
+ warn "CcMdlWriteAbort() not handled";
+}
+
+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);
+ $CObject->{"AcquireForLazyWrite"}--;