Преглед изворни кода

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