瀏覽代碼

* Only start caching a directory once more than 20 lookups have been
done in it, to avoid caching very large current directories (such as
those of the testsuite) without reason. It would be better if that
decision were based on a fraction of the total number of entries in
each directory, but that information doesn not appear to be available
in a cross-platform way

git-svn-id: trunk@8938 -

Jonas Maebe 18 年之前
父節點
當前提交
71c314c550
共有 1 個文件被更改,包括 78 次插入34 次删除
  1. 78 34
      compiler/cfileutl.pas

+ 78 - 34
compiler/cfileutl.pas

@@ -46,18 +46,26 @@ interface
       CUtils,CClasses,
       CUtils,CClasses,
       Systems;
       Systems;
 
 
+    const
+      { On case sensitive file systems, you have 9 lookups per used unit, }
+      { including the system unit, in the current directory               }
+      MinSearchesBeforeCache = 20;
+
     type
     type
       TCachedDirectory = class(TFPHashObject)
       TCachedDirectory = class(TFPHashObject)
       private
       private
         FDirectoryEntries : TFPHashList;
         FDirectoryEntries : TFPHashList;
+        FSearchCount: longint;
         procedure FreeDirectoryEntries;
         procedure FreeDirectoryEntries;
         function GetItemAttr(const AName: TCmdStr): byte;
         function GetItemAttr(const AName: TCmdStr): byte;
+        function TryUseCache: boolean;
+        procedure ForceUseCache;
+        procedure Reload;
       public
       public
         constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
         constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
         destructor  destroy;override;
         destructor  destroy;override;
-        procedure Reload;
         function FileExists(const AName:TCmdStr):boolean;
         function FileExists(const AName:TCmdStr):boolean;
-        function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
+        function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
         function DirectoryExists(const AName:TCmdStr):boolean;
         function DirectoryExists(const AName:TCmdStr):boolean;
         property DirectoryEntries:TFPHashList read FDirectoryEntries;
         property DirectoryEntries:TFPHashList read FDirectoryEntries;
       end;
       end;
@@ -84,7 +92,7 @@ interface
         constructor Create;
         constructor Create;
         destructor  destroy;override;
         destructor  destroy;override;
         function FileExists(const AName:TCmdStr):boolean;
         function FileExists(const AName:TCmdStr):boolean;
-        function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
+        function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
         function DirectoryExists(const AName:TCmdStr):boolean;
         function DirectoryExists(const AName:TCmdStr):boolean;
         function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
         function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
         function FindNext(var Res:TCachedSearchRec):boolean;
         function FindNext(var Res:TCachedSearchRec):boolean;
@@ -175,6 +183,32 @@ implementation
       end;
       end;
 
 
 
 
+    function TCachedDirectory.TryUseCache:boolean;
+      begin
+        Result:=true;
+        if (FSearchCount > MinSearchesBeforeCache) then
+          exit;
+        if (FSearchCount = MinSearchesBeforeCache) then
+          begin
+            inc(FSearchCount);
+            Reload;
+            exit;
+          end;
+        inc(FSearchCount);
+        Result:=false;
+      end;
+
+
+    procedure TCachedDirectory.ForceUseCache;
+      begin
+        if (FSearchCount<=MinSearchesBeforeCache) then
+          begin
+            FSearchCount:=MinSearchesBeforeCache+1;
+            Reload;
+          end;
+      end;
+
+
     procedure TCachedDirectory.FreeDirectoryEntries;
     procedure TCachedDirectory.FreeDirectoryEntries;
       var
       var
         i: Integer;
         i: Integer;
@@ -243,6 +277,12 @@ implementation
       var
       var
         Attr : Longint;
         Attr : Longint;
       begin
       begin
+        if not TryUseCache then
+          begin
+            { prepend directory name again }
+            result:=cfileutl.FileExists(Name+AName,false);
+            exit;
+          end;
         Attr:=GetItemAttr(AName);
         Attr:=GetItemAttr(AName);
         if Attr<>0 then
         if Attr<>0 then
           Result:=((Attr and faDirectory)=0)
           Result:=((Attr and faDirectory)=0)
@@ -251,25 +291,28 @@ implementation
       end;
       end;
 
 
 
 
-    function TCachedDirectory.FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
+    function TCachedDirectory.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
       var
       var
         entry : PCachedDirectoryEntry;
         entry : PCachedDirectoryEntry;
         Attr  : Longint;
         Attr  : Longint;
       begin
       begin
         if (tf_files_case_aware in source_info.flags) then
         if (tf_files_case_aware in source_info.flags) then
           begin
           begin
-            entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
-            if assigned(entry) then
+            if not TryUseCache then
               begin
               begin
-                Attr:=entry^.Attr;
-                FoundName:=entry^.RealName
+                Result:=FileExistsNonCase(path,fn,false,FoundName);
+                exit;
+              end;
+            entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(ExtractFileName(fn))));
+            if assigned(entry) and
+               (entry^.Attr<>0) and
+               ((entry^.Attr and faDirectory) = 0) then
+              begin
+                 FoundName:=ExtractFilePath(path+fn)+entry^.RealName;
+                 Result:=true
               end
               end
             else
             else
-              Attr:=0;
-            if Attr<>0 then
-              Result:=((Attr and faDirectory)=0)
-            else
-              Result:=false
+              Result:=false;
           end
           end
         else
         else
           { should not be called in this case, use plain FileExists }
           { should not be called in this case, use plain FileExists }
@@ -281,6 +324,11 @@ implementation
       var
       var
         Attr : Longint;
         Attr : Longint;
       begin
       begin
+        if not TryUseCache then
+          begin
+            Result:=PathExists(Name+AName,false);
+            exit;
+          end;
         Attr:=GetItemAttr(AName);
         Attr:=GetItemAttr(AName);
         if Attr<>0 then
         if Attr<>0 then
           Result:=((Attr and faDirectory)=faDirectory)
           Result:=((Attr and faDirectory)=faDirectory)
@@ -313,15 +361,12 @@ implementation
         DirName   : TCmdStr;
         DirName   : TCmdStr;
       begin
       begin
         if ADir='' then
         if ADir='' then
-          DirName:='.'
+          DirName:='.'+source_info.DirSep
         else
         else
           DirName:=ADir;
           DirName:=ADir;
         CachedDir:=TCachedDirectory(FDirectories.Find(DirName));
         CachedDir:=TCachedDirectory(FDirectories.Find(DirName));
         if not assigned(CachedDir) then
         if not assigned(CachedDir) then
-          begin
-            CachedDir:=TCachedDirectory.Create(FDirectories,DirName);
-            CachedDir.Reload;
-          end;
+          CachedDir:=TCachedDirectory.Create(FDirectories,DirName);
         Result:=CachedDir;
         Result:=CachedDir;
       end;
       end;
 
 
@@ -331,24 +376,20 @@ implementation
         CachedDir : TCachedDirectory;
         CachedDir : TCachedDirectory;
       begin
       begin
         Result:=false;
         Result:=false;
-        CachedDir:=GetDirectory(ExtractFileDir(AName));
+        CachedDir:=GetDirectory(ExtractFilePath(AName));
         if assigned(CachedDir) then
         if assigned(CachedDir) then
           Result:=CachedDir.FileExists(ExtractFileName(AName));
           Result:=CachedDir.FileExists(ExtractFileName(AName));
       end;
       end;
 
 
 
 
-    function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out FoundName:TCmdStr):boolean;
+    function TDirectoryCache.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
       var
       var
         CachedDir : TCachedDirectory;
         CachedDir : TCachedDirectory;
       begin
       begin
         Result:=false;
         Result:=false;
-        CachedDir:=GetDirectory(ExtractFileDir(AName));
+        CachedDir:=GetDirectory(ExtractFilePath(path+fn));
         if assigned(CachedDir) then
         if assigned(CachedDir) then
-          begin
-            Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
-            if Result then
-              FoundName:=ExtractFilePath(AName)+FoundName;
-          end;
+          Result:=CachedDir.FileExistsCaseAware(path,fn,FoundName);
       end;
       end;
 
 
 
 
@@ -367,6 +408,7 @@ implementation
       begin
       begin
         Res.Pattern:=ExtractFileName(APattern);
         Res.Pattern:=ExtractFileName(APattern);
         Res.CachedDir:=GetDirectory(ExtractFilePath(APattern));
         Res.CachedDir:=GetDirectory(ExtractFilePath(APattern));
+        Res.CachedDir.ForceUseCache;
         Res.EntryIndex:=0;
         Res.EntryIndex:=0;
         if assigned(Res.CachedDir) then
         if assigned(Res.CachedDir) then
           Result:=FindNext(Res)
           Result:=FindNext(Res)
@@ -538,11 +580,10 @@ implementation
                 Search order for case aware systems:
                 Search order for case aware systems:
                  1. NormalCase
                  1. NormalCase
               }
               }
-              FoundFile:=path+fn;
 {$ifdef usedircache}
 {$ifdef usedircache}
               if allowcache then
               if allowcache then
                 begin
                 begin
-                  result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
+                  result:=DirCache.FileExistsCaseAware(path,fn,fn2);
                   if result then
                   if result then
                     begin
                     begin
                       FoundFile:=fn2;
                       FoundFile:=fn2;
@@ -551,12 +592,15 @@ implementation
                 end
                 end
               else
               else
 {$endif usedircache}
 {$endif usedircache}
-                If FileExists(FoundFile,allowcache) then
-                  begin
-                    { don't know the real name in this case }
-                    result:=true;
-                    exit;
-                 end;
+                begin
+                  FoundFile:=path+fn;
+                  If FileExists(FoundFile,allowcache) then
+                    begin
+                      { don't know the real name in this case }
+                      result:=true;
+                      exit;
+                   end;
+                end;
            end
            end
         else
         else
           begin
           begin