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->{"process_thread"}="0x12345678/0x12345678";
  35 # $Object->{"data"}[dataline]{"FileObject"}="0x12345678";
  36 # $Object->{"data"}[dataline]{"FileName"}="\filename" or undef() if NULL;
  37 # $Object->{"data"}[dataline]{"Flags"}="0x40100";
  38 # $Object->{"data"}[dataline]{"SectionObjectPointer"}="0x12345678";
  39 # $Object->{"data"}[dataline]{"SharedCacheMap"}="0x12345678";
  40 # $FileObject{$FileObject}{"FileObject"}="0x12345678";
  41 # $FileObject{$FileObject}{"SectionObjectPointer"}="0x12345678";
  42 # $SectionObjectPointer{$SectionObjectPointer}{"SectionObjectPointer"}="0x12345678";
  43 # $SectionObjectPointer{$SectionObjectPointer}{"SharedCacheMap"}="0x12345678";
  44 # $SharedCacheMap{$SharedCacheMap}{"SharedCacheMap"}="0x12345678";
  45 # $SharedCacheMap{$SharedCacheMap}{"SectionObjectPointer"}="0x12345678";
  46 # $SharedCacheMap{$SharedCacheMap}{"Allocation"}="0x12345";
  47 # $SharedCacheMap{$SharedCacheMap}{"FileSize"}="0x12345";
  48 # $SharedCacheMap{$SharedCacheMap}{"ref_count"}=1;
  49 # $SharedCacheMap{$SharedCacheMap}{"map"}="0x12345678" (Bcb);
  50 # $SharedCacheMap{$SharedCacheMap}{"pin"}{"0x1000"}="0x12345678" (Bcb);
  51 # $SharedCacheMap{$SharedCacheMap}{"PinAccess"}=0 or 1;
  52 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
  53 # $Bcb{$Bcb}{"SharedCacheMap"}="0x12345678";
  54 # $Bcb{$Bcb}{"type"}="pin" or "map";
  55 # $Bcb{$Bcb}{"ref_count"}=1;
  56 # $Bcb{$Bcb}{"FileOffset"}="0x1000" if {"type"} eq "pin";
  57 # $Bcb{$Bcb}{"Buffer"}="0x12345678";    # PAGE_SIZE-aligned for "pin", FileOffset_0-aligned for "map"
  58
  59 my %FileObject;
  60 my %SectionObjectPointer;
  61 my %SharedCacheMap;
  62 my %Bcb;
  63
  64 END {
  65         print Data::Dumper->Dump([\%FileObject,\%SectionObjectPointer,\%SharedCacheMap,\%Bcb],
  66                                [qw(%FileObject  %SectionObjectPointer  %SharedCacheMap  %Bcb)]) if !$filter;
  67         }
  68
  69 my $Object;
  70
  71 sub tohex($)
  72 {
  73 my($num)=@_;
  74
  75         return sprintf("0x%X",$num);
  76 }
  77
  78 sub FObject($)
  79 {
  80 my($FileObject)=@_;
  81
  82         my $FObject=$FileObject{$FileObject};
  83         if (!$FObject) {
  84                 my($package,$filename,$line,$subroutine)=caller 0;
  85                 warn "Non-existent FileObject $FileObject by line $line";
  86                 }
  87         return $FObject;
  88 }
  89
  90 sub SObject($)
  91 {
  92 my($SectionObjectPointer)=@_;
  93
  94         my $SObject=$SectionObjectPointer{$SectionObjectPointer};
  95         if (!$SObject) {
  96                 my($package,$filename,$line,$subroutine)=caller 0;
  97                 warn "Non-existent SectionObjectPointer $SectionObjectPointer by line $line"
  98                 }
  99         return $SObject;
 100 }
 101
 102 sub SObject_from_FileObject($)
 103 {
 104 my($FileObject)=@_;
 105
 106         return if !(my $FObject=FObject $FileObject);
 107         my $SObject=SObject $FObject->{"SectionObjectPointer"};
 108         if (!$SObject) {
 109                 my($package,$filename,$line,$subroutine)=caller 0;
 110                 warn "by line $line";
 111                 }
 112         return $SObject;
 113 }
 114
 115 sub delete_CObject($)
 116 {
 117 my($CObject)=@_;
 118
 119         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 120         do { warn "Trailing map $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for ($CObject->{"map"});
 121         do { warn "Trailing pin $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for (values(%{$CObject->{"pin"}}));
 122         delete $SharedCacheMap{$SharedCacheMap};
 123 }
 124
 125 sub CObject($)
 126 {
 127 my($SharedCacheMap)=@_;
 128
 129         my $CObject=$SharedCacheMap{$SharedCacheMap};
 130         if (!$CObject) {
 131                 my($package,$filename,$line,$subroutine)=caller 0;
 132                 warn "Non-existent SharedCacheMap $SharedCacheMap by line $line";
 133                 }
 134         return $CObject;
 135 }
 136
 137 sub CObject_from_FileObject($)
 138 {
 139 my($FileObject)=@_;
 140
 141         return if !(my $SObject=SObject_from_FileObject $FileObject);
 142         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 143         return $CObject;
 144 }
 145
 146 sub SharedCacheMap_valid($)
 147 {
 148 my($SharedCacheMap)=@_;
 149
 150         cluck if !defined $SharedCacheMap;
 151         return 0 if "0x".("F"x8) eq $SharedCacheMap;
 152         return 0 if !eval $SharedCacheMap;
 153         return 1;
 154 }
 155
 156 sub check_data($)
 157 {
 158 my($data)=@_;
 159
 160         if (!eval $data->{"SectionObjectPointer"}) {
 161                 return if $Object->{"by"} eq "IRP_MJ_CREATE";   # SectionObjectPointer is not yet initialized
 162                 warn "Existing FileObject ".$data->{"FileObject"}." but no SectionObjectPointer found"
 163                                 if $FileObject{$data->{"FileObject"}} && eval($FileObject{$data->{"FileObject"}}{"SectionObjectPointer"});
 164                 return;
 165                 }
 166         my $SectionObjectPointer=$data->{"SectionObjectPointer"};
 167         if (!SharedCacheMap_valid $data->{"SharedCacheMap"} && $SectionObjectPointer{$SectionObjectPointer}) {
 168                 return if !(my $SObject=SObject $SectionObjectPointer);
 169                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 170                 return if !eval $SharedCacheMap;
 171                 my $CObject=CObject $SharedCacheMap;
 172                 warn "Existing SectionObjectPointer ".$data->{"SectionObjectPointer"}." but no SharedCacheMap found,"
 173                                                 ." ref_count of SharedCacheMap is ".$CObject->{"ref_count"}
 174                                 if $CObject->{"ref_count"};
 175 #                               if $SectionObjectPointer{$data->{"SectionObjectPointer"}};
 176                 # SharedCacheMap was droppped by async task as it had ref_count==0.
 177                 delete_CObject $CObject;
 178                 $SObject->{"SharedCacheMap"}=tohex(0);
 179                 # FileObject is still valid!
 180                 return;
 181                 }
 182         return if !$FileObject{$data->{"FileObject"}};
 183         return if !(my $FObject=FObject $data->{"FileObject"});
 184         return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
 185         my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 186         warn "FileObject ".$FObject->{"FileObject"}." SectionObjectPointer ".$SObject->{"SectionObjectPointer"}
 187                                         ." expected SharedCacheMap $SharedCacheMap"
 188                                         ." but found SharedCacheMap ".$data->{"SharedCacheMap"}
 189                         if $SharedCacheMap ne $data->{"SharedCacheMap"};
 190         warn "INTERNAL: SharedCacheMap $SharedCacheMap of FileObject ".$FObject->{"FileObject"}." got destroyed"
 191                         if !$SharedCacheMap{$SharedCacheMap};
 192 }
 193
 194 sub CcInitializeCacheMap($$$$$)
 195 {
 196 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=@_;
 197
 198         $ValidDataLength=$FileSize if $ValidDataLength==eval("0x".("F"x8));
 199         $Object->{"ref_count"}=1;
 200         $Object->{"AllocationSize"}=tohex($AllocationSize);
 201         $Object->{"FileSize"}=tohex($FileSize);
 202         $Object->{"ValidDataLength"}=tohex($ValidDataLength);
 203         $Object->{"map"}=undef();
 204         $Object->{"pin"}={};
 205         $Object->{"PinAccess"}=$PinAccess;
 206         $Object->{"FileObject"}=$FileObject;
 207 }
 208
 209 sub CcInitializeCacheMap_leave()
 210 {
 211         my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 212         $Object->{"SharedCacheMap"}=$SharedCacheMap;
 213         my $old=$SharedCacheMap{$SharedCacheMap};
 214         if (!SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"} && $old) {
 215                 # SharedCacheMap got deleted in the meantime
 216                 delete_CObject CObject $SharedCacheMap;
 217                 my $SObject=SObject $Object->{"data"}[0]{"SectionObjectPointer"};
 218                 $SObject->{"SharedCacheMap"}=tohex(0);
 219                 $old=undef();
 220                 }
 221         if (!$old != !SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 222                 warn "Expecting old SharedCacheMap validity ".(!!$old)
 223                                 ." but found old SharedCacheMap ".$Object->{"data"}[0]{"SharedCacheMap"};
 224                 }
 225         warn "New SharedCacheMap ".$Object->{"data"}[1]{"SharedCacheMap"}." is not valid"
 226                         if !SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"};
 227         if (SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 228                 warn "Existing SharedCacheMap changed"
 229                                                 ." from ".$Object->{"data"}[0]{"SharedCacheMap"}." to ".$Object->{"data"}[1]{"SharedCacheMap"}
 230                                 if $Object->{"data"}[0]{"SharedCacheMap"} ne $Object->{"data"}[1]{"SharedCacheMap"};
 231                 }
 232         if ($old) {
 233                 for my $field (qw(AllocationSize FileSize PinAccess)) {
 234                         warn "SharedCacheMap $SharedCacheMap old instance $field ".$old->{$field}
 235                                                         ." != new instance $field ".$Object->{$field}
 236                                         if $old->{$field} ne $Object->{$field};
 237                         }
 238                 do { warn "Existing map Bcb $_ during CcInitializeCacheMap()" if $_; } for ($old->{"map"});
 239                 do { warn "Existing pin Bcb $_ during CcInitializeCacheMap()" if $_; } for (values(%{$old->{"pin"}}));
 240                 $Object->{"ref_count"}+=$old->{"ref_count"};
 241                 }
 242         $SharedCacheMap{$SharedCacheMap}=$Object;
 243
 244         warn "Changed SectionObjectPointer inside CcInitializeCacheMap()"
 245                                         ." from ".$Object->{"data"}[0]{"SectionObjectPointer"}." to ".$Object->{"data"}[1]{"SectionObjectPointer"}
 246                         if $Object->{"data"}[0]{"SectionObjectPointer"} ne $Object->{"data"}[1]{"SectionObjectPointer"};
 247         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 248
 249         my $FileObject=$Object->{"FileObject"};
 250         if (my $FObject=$FileObject{$FileObject}) {
 251                 if (my $SObject=$SectionObjectPointer{$FObject->{"SectionObjectPointer"}}) {
 252                         warn "Changed SectionObjectPointer of FileObject $FileObject"
 253                                                         ." from ".$FObject->{"SectionObjectPointer"}." to ".$SectionObjectPointer
 254                                         if $FObject->{"SectionObjectPointer"} ne $SectionObjectPointer;
 255                         }
 256                 # Otherwise SectionObjectPointer could be deleted and rebuilt async in the meantime.
 257                 }
 258         $FileObject{$FileObject}={
 259                         "FileObject"=>$FileObject,
 260                         "SectionObjectPointer"=>$SectionObjectPointer,
 261                         };
 262
 263         if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 264                 warn "Changed SharedCacheMap of SectionObjectPointer $SectionObjectPointer"
 265                                                 ." from ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 266                                 if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && eval($SObject->{"SharedCacheMap"});
 267                 }
 268         $SectionObjectPointer{$SectionObjectPointer}={
 269                         "SectionObjectPointer"=>$SectionObjectPointer,
 270                         "SharedCacheMap"=>$SharedCacheMap,
 271                         };
 272
 273         CcSetFileSizes($FileObject,map({ eval($Object->{$_}); } qw(AllocationSize FileSize ValidDataLength)));
 274         delete $Object->{$_} for (qw(FileObject ValidDataLength));
 275 }
 276
 277 sub CcUninitializeCacheMap($$)
 278 {
 279 my($FileObject,$TruncateSize)=@_;
 280
 281         $Object->{"FileObject"}=$FileObject;
 282 }
 283
 284 sub CcUninitializeCacheMap_leave($)
 285 {
 286 my($r)=@_;
 287
 288         my $FileObject=$Object->{"FileObject"};
 289         # 'r' means function success.
 290         # r=0 either if no CcInitializeCacheMap() was called at all
 291         # or if Cc was unable to detach SharedCacheMap and it remains valid
 292         # (FIXME: Do we SharedCacheMap->ref_count-- on in such case?).
 293         my $SectionObjectPointer=$FileObject{$FileObject}->{"SectionObjectPointer"} if $FileObject{$FileObject};
 294         my $SharedCacheMap=$SectionObjectPointer{$SectionObjectPointer}->{"SharedCacheMap"}
 295                         if $SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer};
 296         warn "Unexpected 'r' result $r for CcUninitializeCacheMap of FileObject $FileObject"
 297                         if !(eval($SharedCacheMap) && !SharedCacheMap_valid($Object->{"data"}[1]{"SharedCacheMap"})) != !$r;
 298         if (!eval $SharedCacheMap) {
 299                 for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"},$Object->{"data"}[1]{"SharedCacheMap"}) {
 300                         warn "Not expecting valid SharedCacheMap $SharedCacheMap"
 301                                         if SharedCacheMap_valid $SharedCacheMap;
 302                         }
 303                 return;
 304                 }
 305         for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"}) {
 306                 warn "Expecting valid SharedCacheMap $SharedCacheMap"
 307                                 if !SharedCacheMap_valid $SharedCacheMap;
 308                 }
 309         return if !(my $FObject=FObject $FileObject);
 310         return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
 311         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 312         if (--$CObject->{"ref_count"}) {
 313                 for my $SharedCacheMap ($Object->{"data"}[1]{"SharedCacheMap"}) {
 314                         warn "Expecting still valid SharedCacheMap $SharedCacheMap after CcUninitializeCacheMap()"
 315                                                         ." with ref_count=".$CObject->{"ref_count"}
 316                                         if !SharedCacheMap_valid $SharedCacheMap;
 317                         }
 318                 return;
 319                 }
 320         if (!SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"}) {
 321                 delete_CObject $CObject;
 322                 $SObject->{"SharedCacheMap"}=tohex(0);
 323                 # FileObject is still valid!
 324                 }
 325         else {
 326                 # FIXME: Do we SharedCacheMap->ref_count-- on in such case?
 327                 }
 328 }
 329
 330 sub CcSetFileSizes($$$$)
 331 {
 332 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
 333
 334         return if !(my $CObject=CObject_from_FileObject $FileObject);
 335         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 336         if ($AllocationSize!=eval($CObject->{"AllocationSize"})) {
 337                 do { warn "Existing map $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 338                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 339                                 for ($CObject->{"map"});
 340                 do { warn "Existing pin $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 341                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 342                                 for (values(%{$CObject->{"pin"}}));
 343                 }
 344         # $ValidDataLength can be > $CObject->{"FileSize"};
 345         warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
 346                         if $ValidDataLength>$FileSize;
 347         warn "0 != AllocationSize ".tohex($AllocationSize)." % ntfs_blocksize ".tohex($ntfs_blocksize)
 348                         if 0!=($AllocationSize%$ntfs_blocksize);
 349         # $AllocationSize can be higher
 350         warn "FileSize ".tohex($FileSize)." > AllocationSize ".tohex($AllocationSize)
 351                         if $FileSize>$AllocationSize;
 352         $CObject->{"FileSize"}=tohex($FileSize);
 353         $CObject->{"AllocationSize"}=tohex($AllocationSize);
 354 }
 355
 356 sub IRP_MJ_CREATE_leave()
 357 {
 358         do { warn "Non-NULL SectionObjectPointer $_ not expected" if eval($_); } for ($Object->{"data"}[0]{"SectionObjectPointer"});
 359         my $FileObject=$Object->{"data"}[0]{"FileObject"};
 360         warn "Existing FileObject $FileObject not expected" if $FileObject{$FileObject};
 361         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 362         # We want to track even FileObject without SectionObjectPointer yet.
 363 #       if ($SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer})
 364         {
 365                 $FileObject{$FileObject}={
 366                                 "FileObject"=>$FileObject,
 367                                 "SectionObjectPointer"=>$SectionObjectPointer,
 368                                 };
 369                 }
 370         if (eval $SectionObjectPointer) {
 371                 my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 372                 if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 373                         warn "Changed SharedCacheMap from stored ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 374                                         if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && $Object->{"by"} ne "IRP_MJ_CREATE";
 375                         }
 376                 $SectionObjectPointer{$SectionObjectPointer}={
 377                                 "SectionObjectPointer"=>$SectionObjectPointer,
 378                                 "SharedCacheMap"=>$SharedCacheMap,
 379                                 };
 380                 }
 381 }
 382
 383 sub BObject($)
 384 {
 385 my($Bcb)=@_;
 386
 387         my $BObject=$Bcb{$Bcb};
 388         warn "Non-existent Bcb $Bcb" if !$BObject;
 389         return $BObject;
 390 }
 391
 392 sub Bcb_conflict($;@)
 393 {
 394 my($CObject,@Bcb_list)=@_;
 395
 396         my $arg=0;
 397         my %check=(
 398                 "map"=>$CObject->{"map"},
 399                 map(("arg".($arg++)=>$_),@Bcb_list),
 400                 %{$CObject->{"pin"}},
 401                 );
 402         my %reversed;
 403         my $BufferBase; # relativized to FileOffset 0
 404         my $BufferBase_val;
 405         while (my($key,$val)=each(%check)) {
 406                 next if !defined $val;
 407                 warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
 408                                 if $reversed{$val};
 409                 # Buffer base should match even between 'map's and 'pin's
 410                 # as the data are always mapped only once.
 411                 if (my $BObject=BObject $val) {
 412                         my $Buffer=eval $BObject->{"Buffer"};
 413                         $Buffer-=eval($BObject->{"FileOffset"}) if exists $BObject->{"FileOffset"};
 414                         warn "Non-matching Bcb ".$BObject->{"type"}." $val Buffer base ".tohex($Buffer)
 415                                                         ." with Bcb ".$Bcb{$BufferBase_val}->{"type"}." $BufferBase_val BufferBase ".tohex($BufferBase)
 416                                         if defined($BufferBase) && $Buffer!=$BufferBase;
 417                         $BufferBase=$Buffer;
 418                         $BufferBase_val=$val;
 419                         }
 420                 $reversed{$val}=$key;
 421                 }
 422 }
 423
 424 # New $BObject will always be forced as the last stored reference.
 425 sub Bcb_checkref($$)
 426 {
 427 my($BObject,$ref)=@_;
 428
 429         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 430         my $type=$BObject->{"type"};
 431         my $Bcb=$BObject->{"Bcb"};
 432         if ($$ref) {
 433                 my $BObject2=$Bcb{$$ref};
 434                 warn "new $type Bcb $Bcb != old $type Bcb $$ref"
 435                                 if $Bcb ne $$ref;
 436                 warn "new $type $Bcb type ".$BObject->{"type"}." != old $type $$ref type ".$BObject2->{"type"}
 437                                 if $BObject->{"type"} ne $BObject2->{"type"};
 438                 warn "new $type $Bcb Buffer ".$BObject->{"Buffer"}." != old $type $$ref Buffer ".$BObject2->{"Buffer"}
 439                                 if $BObject->{"Buffer"} ne $BObject2->{"Buffer"};
 440                 }
 441         if ($$ref && $$ref eq $Bcb) {
 442                 $BObject->{"ref_count"}+=$Bcb{$$ref}->{"ref_count"};
 443                 $$ref=undef();
 444                 }
 445         $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
 446         Bcb_conflict $CObject,$Bcb;
 447         $$ref=$Bcb;
 448 }
 449
 450 sub map_new($;$$)
 451 {
 452 my($SharedCacheMap,$FileOffset,$Length)=@_;
 453
 454         return if !(my $CObject=CObject $SharedCacheMap);
 455         if (defined($FileOffset) && defined($Length)) {
 456                 warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 457                                 if $FileOffset+$Length>eval($CObject->{"FileSize"});
 458                 }
 459         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 460         if (defined $FileOffset) {
 461                 $Object->{"FileOffset"}=tohex($FileOffset);
 462                 }
 463         $Object->{"type"}="map";
 464         $Object->{"ref_count"}=1;
 465 }
 466
 467 sub map_new_from_FileObject($;$$)
 468 {
 469 my($FileObject,$FileOffset,$Length)=@_;
 470
 471         return if !(my $CObject=CObject_from_FileObject $FileObject);
 472         map_new $CObject->{"SharedCacheMap"},$FileOffset,$Length;
 473 }
 474
 475 sub map_new_leave($;$)
 476 {
 477 my($Bcb,$Buffer)=@_;
 478
 479         $Object->{"Bcb"}=$Bcb;
 480         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 481
 482         if (defined $Buffer) {
 483                 $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
 484                 }
 485         delete $Object->{"FileOffset"};
 486
 487         my $ref=\$CObject->{"map"};
 488         # There may exist some pin bcbs even if we are creating the new map bcb.
 489         Bcb_checkref $Object,$ref;
 490 }
 491
 492 sub CcMapData($$$)
 493 {
 494 my($FileObject,$FileOffset,$Length)=@_;
 495
 496         map_new_from_FileObject $FileObject,$FileOffset,$Length;
 497 }
 498
 499 sub CcMapData_leave($$)
 500 {
 501 my($Bcb,$Buffer)=@_;
 502
 503         map_new_leave $Bcb,$Buffer;
 504 }
 505
 506 sub pin_new($$$)
 507 {
 508 my($FileObject,$FileOffset,$Length)=@_;
 509
 510         return if !(my $CObject=CObject_from_FileObject $FileObject);
 511         warn "Pinning of non-PinAccess FileObject $FileObject" if !$CObject->{"PinAccess"};
 512         warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 513                         if $FileOffset+$Length>eval($CObject->{"FileSize"});
 514         warn "Pinning Length ".tohex($Length)." > 0x1000" if $Length>0x1000;
 515         warn "Pinning across file page (start=".tohex($FileOffset).",end-1=".tohex($FileOffset+$Length-1).")"
 516                         if ($FileOffset&~0xFFF)!=(($FileOffset+$Length-1)&~0xFFF);
 517         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 518         $Object->{"FileOffset"}=tohex($FileOffset);
 519         $Object->{"type"}="pin";
 520         $Object->{"ref_count"}=1;
 521 }
 522
 523 sub pin_new_leave($$)
 524 {
 525 my($Bcb,$Buffer)=@_;
 526
 527         $Object->{"Bcb"}=$Bcb;
 528         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 529         $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"})&0xFFF));
 530         my $shift=eval($Object->{"FileOffset"})&0xFFF;
 531         $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
 532         $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 533
 534         my $ref=\$CObject->{"pin"}{$Object->{"FileOffset"}};
 535         # There may not exist map bcb even if we are creating the new pin bcb.
 536         Bcb_checkref $Object,$ref;
 537 }
 538
 539 sub CcPinRead($$$)
 540 {
 541 my($FileObject,$FileOffset,$Length)=@_;
 542
 543         pin_new $FileObject,$FileOffset,$Length;
 544 }
 545
 546 sub CcPinRead_leave($$)
 547 {
 548 my($Bcb,$Buffer)=@_;
 549
 550         pin_new_leave $Bcb,$Buffer;
 551 }
 552
 553 sub CcPreparePinWrite($$$)
 554 {
 555 my($FileObject,$FileOffset,$Length)=@_;
 556
 557         pin_new $FileObject,$FileOffset,$Length;
 558 }
 559
 560 sub CcPreparePinWrite_leave($$)
 561 {
 562 my($Bcb,$Buffer)=@_;
 563
 564         pin_new_leave $Bcb,$Buffer;
 565 }
 566
 567 sub CcPinMappedData($$$)
 568 {
 569 my($FileObject,$FileOffset,$Length)=@_;
 570
 571         pin_new $FileObject,$FileOffset,$Length;
 572 }
 573
 574 sub CcPinMappedData_leave($)
 575 {
 576 my($Bcb)=@_;
 577
 578         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 579         do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed SharedCacheMap ".$CObject->{"SharedCacheMap"}; return; }
 580                         if !(my $mapBcb=$CObject->{"map"});
 581         return if !(my $BmapObject=BObject $mapBcb);
 582         my $Buffer=tohex(eval($BmapObject->{"Buffer"})+eval($Object->{"FileOffset"}));
 583
 584         my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
 585         my $BObject2=BObject $Bcb2 if $Bcb2;
 586         if ($BObject2 && $BObject2->{"CcPinMappedData_double"}
 587                         && eval($BObject2->{"CcPinMappedData_double"})==eval($Object->{"FileOffset"})) {        # unaligned yet
 588                 my $BmapBuffer=eval($BmapObject->{"Buffer"})+(eval($Object->{"FileOffset"})&~0xFFF);
 589                 warn "CcPinMappedData-double cludge non-matching new Bcb $Bcb != old Bcb ".$BObject2->{"Bcb"}
 590                                 if $Bcb ne $BObject2->{"Bcb"};
 591                 warn "CcPinMappedData-double cludge non-matching Buffer new Bcb $Bcb Buffer $BmapBuffer"
 592                                                 ." != old Bcb ".$BObject2->{"Bcb"}." Buffer ".$BObject2->{"Buffer"}
 593                                 if eval($BmapBuffer)!=eval($BObject2->{"Buffer"});
 594                 return;
 595                 }
 596
 597         # It appears as this cludge is not needed:
 598 #       $Object->{"CcPinMappedData_double"}=$Object->{"FileOffset"};    # unaligned yet
 599
 600         pin_new_leave $Bcb,$Buffer;
 601 #       print STDERR "$.:".Dumper($Object);
 602 }
 603
 604 sub CcSetDirtyPinnedData($$)
 605 {
 606 my($Bcb,$Lsn)=@_;
 607
 608         return if !(my $BObject=BObject $Bcb);
 609         delete $BObject->{"CcPinMappedData_double"};
 610 }
 611
 612 sub CcRemapBcb($)
 613 {
 614 my($Bcb)=@_;
 615
 616         return if !(my $BObject=BObject $Bcb);
 617         map_new $BObject->{"SharedCacheMap"};
 618         $Object->{"Buffer"}=tohex(eval($BObject->{"Buffer"})-eval($BObject->{"FileOffset"} || 0));
 619 }
 620
 621 sub CcRemapBcb_leave($)
 622 {
 623 my($r)=@_;
 624
 625         map_new_leave $r;
 626 }
 627
 628 sub unpin($)
 629 {
 630 my($Bcb)=@_;
 631
 632         return if !(my $BObject=BObject $Bcb);
 633         delete $BObject->{"CcPinMappedData_double"};
 634         return if --$BObject->{"ref_count"};
 635         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 636         if ($BObject->{"type"} eq "map") {
 637                 for my $pin (values(%{$CObject->{"pin"}})) {
 638                         warn "unpin map but CcPinMappedData pin $pin still exists"
 639                                         if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
 640                         }
 641                 }
 642         for my $ref ($BObject->{"type"} eq "map" ? \$CObject->{"map"} : \$CObject->{"pin"}{$BObject->{"FileOffset"}}) {
 643                 warn "Final unpin but ".$BObject->{"type"}." Bcb $Bcb not registered"
 644                                                 ." in SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref ".($$ref || "<undef>")
 645                                 if !defined($BObject->{"OwnerPointer"}) && !($$ref && $$ref eq $Bcb);
 646                 if ($$ref && $$ref eq $Bcb) {
 647                         $$ref=undef();
 648                         delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
 649                         }
 650                 }
 651         delete $Bcb{$Bcb};
 652 }
 653
 654 sub CcUnpinData($)
 655 {
 656 my($Bcb)=@_;
 657
 658         unpin $Bcb;
 659 }
 660
 661 sub CcUnpinDataForThread($)
 662 {
 663 my($Bcb)=@_;
 664
 665         unpin $Bcb;
 666 }
 667
 668 sub CcSetBcbOwnerPointer($$)
 669 {
 670 my($Bcb,$OwnerPointer)=@_;
 671
 672         return if !(my $BObject=BObject $Bcb);
 673         warn "CcSetBcbOwnerPointer() on map Bcb $Bcb" if $BObject->{"type"} ne "pin";
 674         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 675         warn "Double CcSetBcbOwnerPointer() on Bcb $Bcb" if defined $BObject->{"OwnerPointer"};
 676         my $val=$CObject->{"pin"}{$BObject->{"FileOffset"}};
 677         warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
 678         delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
 679         $BObject->{"OwnerPointer"}=$OwnerPointer;
 680 }
 681
 682 sub IRP_MJ_CLOSE_leave()
 683 {
 684         my $FileObject=$Object->{"data"}[0]{"FileObject"};
 685 #       # IRP_MJ_CLOSE of FileObject w/o CcInitializeCacheMap()?
 686 #       return if !$FileObject{$FileObject};
 687         return if !(my $FObject=FObject $FileObject);
 688         if (eval(my $SectionObjectPointer=$FObject->{"SectionObjectPointer"})) {
 689                 return if !(my $SObject=SObject $SectionObjectPointer);
 690                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 691                 if (eval $SharedCacheMap) {
 692                         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 693                         # SharedCacheMap may still exist for FCB although this FileObject gets destroyed now.
 694 #                       warn "SectionObjectPointer $SectionObjectPointer still exists during IRP_MJ_CLOSE"
 695 #                                                       ." while SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref_count ".$CObject->{"ref_count"}
 696 #                                       if $SectionObjectPointer && $CObject->{"ref_count"};
 697                         }
 698                 }
 699         delete $FileObject{$FileObject};
 700 }
 701
 702
 703 local $_;
 704 my $hex='0x[\dA-F]+';
 705 my %last_irp_mj;
 706 my %enter_leave;
 707 while (<>) {
 708         chomp;
 709         s/\r$//;
 710         # We may get some foreign garbage without '\n' before our debug data line:
 711         # Do not use '\bTraceFS' as there really can be precediny _any_ data.
 712         s#^.*?TraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
 713         my($process_thread)=($1);
 714
 715         $Object=undef();
 716         if (/^enter: (\w+)/) {
 717                 $Object={};
 718                 $Object->{"by"}=$1;
 719                 $Object->{"line_enter"}=$.;
 720                 $Object->{"process_thread"}=$process_thread;
 721                 push @{$enter_leave{$process_thread}},$Object;
 722                 }
 723         elsif (/^leave: (\w+)/) {
 724                 warn "Empty pop stack during 'leave' of $1" if !($Object=pop @{$enter_leave{$process_thread}});
 725                 warn "Non-matching popped 'by' ".$Object->{"by"}." ne current 'leave' $1"
 726                                 if $Object->{"by"} ne $1;
 727                 $Object->{"line_leave"}=$.;
 728                 }
 729         elsif (my($FileObject,$FileName,$Flags,$SectionObjectPointer,$SharedCacheMap)=
 730                         /^FileObject=($hex): FileName=(?:NULL|'(.*)'),Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
 731                 my $aref=$enter_leave{$process_thread};
 732                 warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
 733                 my $data={
 734                                 "FileObject"=>$FileObject,
 735                                 "FileName"=>$FileName,
 736                                 "Flags"=>$Flags,
 737                                 "SectionObjectPointer"=>$SectionObjectPointer,
 738                                 "SharedCacheMap"=>$SharedCacheMap,
 739                                 "line"=>$.,
 740                                 };
 741                 push @{$Object->{"data"}},$data;
 742                 my $isinit={ map(($_=>1),qw(
 743                                 CcInitializeCacheMap
 744                                 CcUninitializeCacheMap
 745                                 IRP_MJ_CREATE
 746                                 )) }->{$Object->{"by"}};
 747                 check_data $data
 748                                 if 1==@{$Object->{"data"}} || !$isinit;
 749                 if ($isinit) {
 750                         # Prevent 'SharedCacheMap' 0->N change by CcInitializeCacheMap() called inside.
 751                         for my $ref (@$aref[0..$#$aref-1]) {
 752                                 $ref->{"data"}[0]->{"SharedCacheMap"}=$SharedCacheMap;
 753                                 }
 754                         }
 755                 if (2<=@{$Object->{"data"}}) {
 756                         my $data_prev=$Object->{"data"}[$#{$Object->{"data"}}-1];
 757                         for my $field (qw(FileObject FileName Flags),($isinit ? () : qw(SharedCacheMap))) {
 758                                 next if !defined(my $prev=$data_prev->{$field});
 759                                 next if !defined(my $now=$data->{$field});
 760                                 my $by=$Object->{"by"};
 761                                 if ($field eq "Flags") {
 762                                         next if $by eq "IRP_MJ_CREATE" && $field eq "Flags";
 763                                         my $FO_CLEANUP_COMPLETE=0x4000;
 764                                         $now=tohex(eval($now)&~$FO_CLEANUP_COMPLETE) if $by eq "IRP_MJ_CLEANUP";
 765                                         my $FO_FILE_FAST_IO_READ=0x80000;
 766                                         $prev=tohex(eval($prev)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_CLEANUP";
 767                                         $now=tohex(eval($now)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_READ" && !(eval($prev)&$FO_FILE_FAST_IO_READ);
 768                                         my $FO_FILE_MODIFIED=0x1000;
 769                                         $now=tohex(eval($now)&~$FO_FILE_MODIFIED) if $by eq "IRP_MJ_WRITE" && !(eval($prev)&$FO_FILE_MODIFIED);
 770                                         my $FO_FILE_SIZE_CHANGED=0x2000;
 771                                         $prev=tohex(eval($prev)&~$FO_FILE_MODIFIED)
 772                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_MODIFIED);
 773                                         $prev=tohex(eval($prev)&~$FO_FILE_SIZE_CHANGED)
 774                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_SIZE_CHANGED);
 775                                         }
 776                                 next if $by eq "IRP_MJ_CLOSE" && $field eq "FileName";
 777                                 $prev=~s#\\$## if $by eq "IRP_MJ_CREATE";
 778                                 $prev="\\" if $by eq "IRP_MJ_CREATE" && $prev eq "";
 779                                 $prev=~s#:.*## if $by eq "IRP_MJ_CREATE" && $prev ne $now;
 780                                 next if $field eq "SharedCacheMap" && !SharedCacheMap_valid $prev && !SharedCacheMap_valid $now;
 781                                 do { warn "Changed data field $field, prev=".$data_prev->{$field}.", now=".$data->{$field}." by $by";
 782 #                                               print STDERR Dumper $data_prev,$data;
 783                                                 } if $prev ne $now;
 784                                 }
 785                         }
 786                 next;
 787                 }
 788
 789         if (my($r)=
 790                         /^leave: IRP_MJ_\w+: r=($hex)/) {
 791                 # Failed requests should make no consequences.
 792                 next if eval($r);
 793                 }
 794
 795         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=
 796                         /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
 797                 CcInitializeCacheMap $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength),eval($PinAccess);
 798                 next;
 799                 }
 800         if (/^leave: CcInitializeCacheMap\b/) {
 801                 CcInitializeCacheMap_leave;
 802                 next;
 803                 }
 804
 805         if (my($FileObject,$TruncateSize)=
 806                         /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
 807                 CcUninitializeCacheMap $FileObject,eval($TruncateSize);
 808                 next;
 809                 }
 810         if (my($r)=
 811                         /^leave: CcUninitializeCacheMap: r=([01])/) {
 812                 CcUninitializeCacheMap_leave $r;
 813                 next;
 814                 }
 815
 816         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
 817                         /^enter: CcSetFileSizes: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex)/) {
 818                 CcSetFileSizes $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength);
 819                 next;
 820                 }
 821
 822         if (/^leave: IRP_MJ_CREATE\b/) {
 823                 IRP_MJ_CREATE_leave;
 824                 next;
 825                 }
 826
 827         if (/^leave: IRP_MJ_CLOSE\b/) {
 828                 IRP_MJ_CLOSE_leave;
 829                 next;
 830                 }
 831
 832         if (my($FileObject,$FileOffset,$Length)=
 833                         /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 834                 CcMapData $FileObject,eval($FileOffset),eval($Length);
 835                 next;
 836                 }
 837         if (my($Bcb,$Buffer)=
 838                         /^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
 839                 CcMapData_leave $Bcb,$Buffer;
 840                 next;
 841                 }
 842
 843         if (my($FileObject,$FileOffset,$Length)=
 844                         /^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 845                 CcPinRead $FileObject,eval($FileOffset),eval($Length);
 846                 next;
 847                 }
 848         if (my($Bcb,$Buffer)=
 849                         /^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
 850                 CcPinRead_leave $Bcb,$Buffer;
 851                 next;
 852                 }
 853
 854         if (my($FileObject,$FileOffset,$Length)=
 855                         /^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
 856                 CcPreparePinWrite $FileObject,eval($FileOffset),eval($Length);
 857                 next;
 858                 }
 859         if (my($Bcb,$Buffer)=
 860                         /^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
 861                 CcPreparePinWrite_leave $Bcb,$Buffer;
 862                 next;
 863                 }
 864
 865         if (my($FileObject,$FileOffset,$Length)=
 866                         /^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
 867                 CcPinMappedData $FileObject,eval($FileOffset),eval($Length);
 868                 next;
 869                 }
 870         if (my($Bcb)=
 871                         /^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
 872                 CcPinMappedData_leave $Bcb;
 873                 next;
 874                 }
 875
 876         if (my($BcbVoid,$Lsn)=
 877                         /^enter: CcSetDirtyPinnedData: BcbVoid=($hex),Lsn=($hex)/) {
 878                 CcSetDirtyPinnedData $BcbVoid,$Lsn;
 879                 next;
 880                 }
 881
 882         if (my($Bcb)=
 883                         /^enter: CcRemapBcb: Bcb=($hex)/) {
 884                 CcRemapBcb $Bcb;
 885                 next;
 886                 }
 887         if (my($r)=
 888                         /^leave: CcRemapBcb: r=($hex)/) {
 889                 CcRemapBcb_leave $r;
 890                 next;
 891                 }
 892
 893         if (my($Bcb)=
 894                         /^enter: CcUnpinData: Bcb=($hex)/) {
 895                 CcUnpinData $Bcb;
 896                 next;
 897                 }
 898         if (my($Bcb)=
 899                         /^enter: CcUnpinDataForThread: Bcb=($hex)/) {
 900                 CcUnpinDataForThread $Bcb;
 901                 next;
 902                 }
 903
 904         if (my($Bcb,$OwnerPointer)=
 905                         /^enter: CcSetBcbOwnerPointer: Bcb=($hex),OwnerPointer=($hex)/) {
 906                 CcSetBcbOwnerPointer $Bcb,$OwnerPointer;
 907                 next;
 908                 }
 909
 910         print "$_\n" if $filter;
 911         }
 912 for my $FileObject (keys(%FileObject)) {
 913         warn "EXIT: still CcInitializeCacheMap FileObject $FileObject";
 914         next if !(my $FObject=FObject $FileObject);
 915         }