MG: added global write lock

git-svn-id: trunk@647 -

components/codetools/codetoolmanager.pas

@@ -71,6 +71,8 @@ type
     FSourceTools: TAVLTree; // tree of TCustomCodeTool
     FVisibleEditorLines: integer;
     FWriteExceptions: boolean;
+    FWriteLockCount: integer;// Set/Unset counter
+    FWriteLockStep: integer; // current write lock ID
     function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator;
     procedure OnDefineTreeReadValue(Sender: TObject; const VariableName: string;
                                     var Value: string);
@@ -90,6 +92,11 @@ type
     function HandleException(AnException: Exception): boolean;
     function OnGetCodeToolForBuffer(Sender: TObject;
       Code: TCodeBuffer): TFindDeclarationTool;
+    procedure ActivateWriteLock;
+    procedure DeactivateWriteLock;
+    procedure OnToolSetWriteLock(Lock: boolean);
+    procedure OnToolGetWriteLockInfo(var WriteLockIsSet: boolean;
+      var WriteLockStep: integer);
   public
     DefinePool: TDefinePool; // definition templates (rules)
     DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
@@ -433,6 +440,8 @@ begin
     // create a scanner for the unit/program
     Result.Scanner:=TLinkScanner.Create;
     Result.Scanner.OnGetInitValues:=@OnScannerGetInitValues;
+    Result.Scanner.OnSetGlobalWriteLock:=@OnToolSetWriteLock;
+    Result.Scanner.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo;
   end;
 end;
 
@@ -1360,6 +1369,35 @@ writeln('[TCodeToolManager.OnGetCodeToolForBuffer]'
   Result:=TFindDeclarationTool(GetCodeToolForSource(Code,true));
 end;
 
+procedure TCodeToolManager.ActivateWriteLock;
+begin
+  if FWriteLockCount=0 then begin
+    // start a new write lock
+    if FWriteLockStep<>$7fffffff then
+      inc(FWriteLockStep)
+    else
+      FWriteLockStep:=-$7fffffff;
+  end;
+  inc(FWriteLockCount);
+end;
+
+procedure TCodeToolManager.DeactivateWriteLock;
+begin
+  if FWriteLockCount>0 then dec(FWriteLockCount);
+end;
+
+procedure TCodeToolManager.OnToolGetWriteLockInfo(var WriteLockIsSet: boolean;
+  var WriteLockStep: integer);
+begin
+  WriteLockIsSet:=FWriteLockCount>0;
+  WriteLockStep:=FWriteLockStep;
+end;
+
+procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean);
+begin
+  if Lock then ActivateWriteLock else DeactivateWriteLock;
+end;
+
 function TCodeToolManager.ConsistencyCheck: integer;
 // 0 = ok
 begin

components/codetools/customcodetool.pas

@@ -1377,7 +1377,7 @@ end;
 function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
 begin
 {$IFDEF CTDEBUG}
-writeln('TCustomCodeTool.UpdateNeeded A ',Scanner<>nil);
+writeln('TCustomCodeTool.UpdateNeeded A ',Scanner<>nil,' FForceUpdateNeeded=',FForceUpdateNeeded);
 {$ENDIF}
   if FForceUpdateNeeded then begin
     Result:=true;
@@ -1387,7 +1387,7 @@ writeln('TCustomCodeTool.UpdateNeeded A ',Scanner<>nil);
            or (Scanner.UpdateNeeded(OnlyInterfaceNeeded, CheckFilesOnDisk));
   FForceUpdateNeeded:=Result;
 {$IFDEF CTDEBUG}
-writeln('TCustomCodeTool.UpdateNeeded END');
+writeln('TCustomCodeTool.UpdateNeeded END  Result=',Result);
 {$ENDIF}
 end;
 
@@ -1475,7 +1475,6 @@ begin
   Tree.Clear;
 end;
 
-
 { ECodeToolError }
 
 constructor ECodeToolError.Create(ASender: TCustomCodeTool;

components/codetools/finddeclarationtool.pas

@@ -293,9 +293,9 @@ type
 
   TFindDeclarationTool = class(TPascalParserTool)
   private
-    FOnGetUnitSourceSearchPath: TOnGetSearchPath;
-    FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
     FInterfaceIdentifierCache: TInterfaceIdentifierCache;
+    FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
+    FOnGetUnitSourceSearchPath: TOnGetSearchPath;
     {$IFDEF CTDEBUG}
     DebugPrefix: string;
     procedure IncPrefix;
@@ -388,10 +388,10 @@ type
       AnUnitInFilename: string): TCodeBuffer;
     property InterfaceIdentifierCache: TInterfaceIdentifierCache
       read FInterfaceIdentifierCache;
-    property OnGetUnitSourceSearchPath: TOnGetSearchPath
-      read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
     property OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer
       read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
+    property OnGetUnitSourceSearchPath: TOnGetSearchPath
+      read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
   end;
 
   //----------------------------------------------------------------------------
@@ -563,76 +563,81 @@ var CleanCursorPos: integer;
   Params: TFindDeclarationParams;
 begin
   Result:=false;
-  // build code tree
+  Scanner.ActivateGlobalWriteLock;
+  try
+    // build code tree
 {$IFDEF CTDEBUG}
 writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration A CursorPos=',CursorPos.X,',',CursorPos.Y);
 {$ENDIF}
-  BuildTreeAndGetCleanPos(false,CursorPos,CleanCursorPos);
+    BuildTreeAndGetCleanPos(false,CursorPos,CleanCursorPos);
 {$IFDEF CTDEBUG}
 writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration C CleanCursorPos=',CleanCursorPos);
 {$ENDIF}
-  // find CodeTreeNode at cursor
-  CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
-  if IsIncludeDirectiveAtPos(CleanCursorPos,CursorNode.StartPos,NewPos.Code)
-  then begin
-    NewPos.X:=1;
-    NewPos.Y:=1;
-    NewTopLine:=1;
-    Result:=true;
-    exit;
-  end;
+    // find CodeTreeNode at cursor
+    CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
+    if IsIncludeDirectiveAtPos(CleanCursorPos,CursorNode.StartPos,NewPos.Code)
+    then begin
+      NewPos.X:=1;
+      NewPos.Y:=1;
+      NewTopLine:=1;
+      Result:=true;
+      exit;
+    end;
 {$IFDEF CTDEBUG}
 writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc));
 {$ENDIF}
-  if CursorNode.Desc=ctnUsesSection then begin
-    // find used unit
-    Result:=FindDeclarationInUsesSection(CursorNode,CleanCursorPos,
-                                         NewPos,NewTopLine);
-  end else begin
-    // first test if in a class
-    ClassNode:=CursorNode;
-    while (ClassNode<>nil) and (ClassNode.Desc<>ctnClass) do
-      ClassNode:=ClassNode.Parent;
-    if ClassNode<>nil then begin
-      // cursor is in class/object definition
-      if (ClassNode.SubDesc and ctnsForwardDeclaration)=0 then begin
-        // parse class and build CodeTreeNodes for all properties/methods
-        BuildSubTreeForClass(ClassNode);
+    if CursorNode.Desc=ctnUsesSection then begin
+      // find used unit
+      Result:=FindDeclarationInUsesSection(CursorNode,CleanCursorPos,
+                                           NewPos,NewTopLine);
+    end else begin
+      // first test if in a class
+      ClassNode:=CursorNode;
+      while (ClassNode<>nil) and (ClassNode.Desc<>ctnClass) do
+        ClassNode:=ClassNode.Parent;
+      if ClassNode<>nil then begin
+        // cursor is in class/object definition
+        if (ClassNode.SubDesc and ctnsForwardDeclaration)=0 then begin
+          // parse class and build CodeTreeNodes for all properties/methods
+          BuildSubTreeForClass(ClassNode);
+          CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
+        end;
+      end;
+      if CursorNode.Desc=ctnBeginBlock then begin
+        BuildSubTreeForBeginBlock(CursorNode);
         CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
       end;
-    end;
-    if CursorNode.Desc=ctnBeginBlock then begin
-      BuildSubTreeForBeginBlock(CursorNode);
-      CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
-    end;
-    MoveCursorToCleanPos(CleanCursorPos);
-    while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do
-      dec(CurPos.StartPos);
-    if (CurPos.StartPos>=1) and (IsIdentStartChar[Src[CurPos.StartPos]]) then
-    begin
-      CurPos.EndPos:=CurPos.StartPos;
-      while (CurPos.EndPos<=SrcLen) and IsIdentChar[Src[CurPos.EndPos]] do
-        inc(CurPos.EndPos);
-      // find declaration of identifier
-      Params:=TFindDeclarationParams.Create;
-      try
-        Params.ContextNode:=CursorNode;
-        Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier);
-        Params.Flags:=[fdfSearchInAncestors,fdfSearchInParentNodes,
-                       fdfExceptionOnNotFound];
-        Result:=FindDeclarationOfIdentifier(Params);
-        if Result then begin
-          Params.ConvertResultCleanPosToCaretPos;
-          NewPos:=Params.NewPos;
-          NewTopLine:=Params.NewTopLine;
+      MoveCursorToCleanPos(CleanCursorPos);
+      while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do
+        dec(CurPos.StartPos);
+      if (CurPos.StartPos>=1) and (IsIdentStartChar[Src[CurPos.StartPos]]) then
+      begin
+        CurPos.EndPos:=CurPos.StartPos;
+        while (CurPos.EndPos<=SrcLen) and IsIdentChar[Src[CurPos.EndPos]] do
+          inc(CurPos.EndPos);
+        // find declaration of identifier
+        Params:=TFindDeclarationParams.Create;
+        try
+          Params.ContextNode:=CursorNode;
+          Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier);
+          Params.Flags:=[fdfSearchInAncestors,fdfSearchInParentNodes,
+                         fdfExceptionOnNotFound];
+          Result:=FindDeclarationOfIdentifier(Params);
+          if Result then begin
+            Params.ConvertResultCleanPosToCaretPos;
+            NewPos:=Params.NewPos;
+            NewTopLine:=Params.NewTopLine;
+          end;
+        finally
+          Params.Free;
         end;
-      finally
-        Params.Free;
+      end else begin
+        // find declaration of not identifier
+
       end;
-    end else begin
-      // find declaration of not identifier
-      
     end;
+  finally
+    Scanner.DeactivateGlobalWriteLock;
   end;
 end;
 
@@ -3851,7 +3856,8 @@ begin
   while IsIdentChar[Identifier[Len]] do inc(Len);
   GetMem(Result,Len+1);
   Move(Identifier^,Result^,Len+1);
-  if FItems=nil then FItems:=TAVLTree.Create(@CompareIdentifiers);
+  if FItems=nil then
+    FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
   FItems.Add(Result);
 end;
 

components/codetools/linkscanner.pas

@@ -59,6 +59,10 @@ type
   TOnCheckFileOnDisk = function(Code: Pointer): boolean of object;
   TOnGetInitValues = function(Code: Pointer): TExpressionEvaluator of object;
   TOnIncludeCode = procedure(ParentCode, IncludeCode: Pointer) of object;
+  TOnSetWriteLock = procedure(Lock: boolean) of object;
+  TOnGetWriteLockInfo = procedure(var WriteLockIsSet: boolean;
+    var WriteLockStep: integer) of object;
+
 
   TSourceLink = record
     CleanedPos: integer;
@@ -98,6 +102,9 @@ type
     FIgnoreMissingIncludeFiles: boolean;
     FNestedComments: boolean;
     FForceUpdateNeeded: boolean;
+    FLastGlobalWriteLockStep: integer;
+    FOnGetGlobalWriteLockInfo: TOnGetWriteLockInfo;
+    FOnSetGlobalWriteLock: TOnSetWriteLock;
     function GetLinks(Index: integer): TSourceLink;
     procedure SetLinks(Index: integer; const Value: TSourceLink);
     procedure SetSource(ACode: Pointer); // set current source
@@ -215,9 +222,17 @@ type
     property ScanTillInterfaceEnd: boolean
         read FScanTillInterfaceEnd write SetScanTillInterfaceEnd;
     procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
+    
     function UpdateNeeded(OnlyInterfaceNeeded,
         CheckFilesOnDisk: boolean): boolean;
     property ChangeStep: integer read FChangeStep;
+    procedure ActivateGlobalWriteLock;
+    procedure DeactivateGlobalWriteLock;
+    property OnGetGlobalWriteLockInfo: TOnGetWriteLockInfo
+      read FOnGetGlobalWriteLockInfo write FOnGetGlobalWriteLockInfo;
+    property OnSetGlobalWriteLock: TOnSetWriteLock
+      read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
+
     procedure Clear;
     function ConsistencyCheck: integer;
     procedure WriteDebugReport;
@@ -851,9 +866,29 @@ function TLinkScanner.UpdateNeeded(
 var i: integer;
   SrcLog: TSourceLog;
   NewInitValues: TExpressionEvaluator;
+  GlobalWriteLockIsSet: boolean;
+  GlobalWriteLockStep: integer;
 begin
   Result:=true;
   if FForceUpdateNeeded then exit;
+  if Assigned(OnGetGlobalWriteLockInfo) then begin
+    OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
+    if GlobalWriteLockIsSet then begin
+      // The global write lock is set. That means, input variables and code are
+      // frozen
+      if (FLastGlobalWriteLockStep=GlobalWriteLockStep) then begin
+        // source and values did not change since last UpdateNeeded check
+        // -> check only if ScanRange has increased
+        if (OnlyInterfaceNeeded=false) and (not EndOfSourceFound) then exit;
+        Result:=false;
+        exit;
+      end else begin
+        // this is the first check in this GlobalWriteLockStep
+        FLastGlobalWriteLockStep:=GlobalWriteLockStep;
+        // proceed normally ...
+      end;
+    end;
+  end;
   FForceUpdateNeeded:=true;
 //writeln('TLinkScanner.UpdateNeeded A OnlyInterface=',OnlyInterfaceNeeded,' EndOfSourceFound=',EndOfSourceFound);
   if LinkCount=0 then exit;
@@ -1629,6 +1664,16 @@ begin
   end;
 end;
 
+procedure TLinkScanner.ActivateGlobalWriteLock;
+begin
+  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);
+end;
+
+procedure TLinkScanner.DeactivateGlobalWriteLock;
+begin
+  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false);
+end;
+
 
 //------------------------------------------------------------------------------
 procedure InternalInit;

components/codetools/pascalparsertool.pas

@@ -214,6 +214,7 @@ type
     function NodeHasParentOfType(ANode: TCodeTreeNode;
         NodeDesc: TCodeTreeNodeDesc): boolean;
     function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
+    
     constructor Create;
     destructor Destroy; override;
   end;
@@ -467,15 +468,15 @@ end;
 
 procedure TPascalParserTool.BuildTree(OnlyInterfaceNeeded: boolean);
 begin
-writeln('TPascalParserTool.BuildTree A OnlyInterfaceNeeded=',OnlyInterfaceNeeded,
-  '  ',TCodeBuffer(Scanner.MainCode).Filename);
 {$IFDEF MEM_CHECK}
 CheckHeap('TBasicCodeTool.BuildTree A '+IntToStr(GetMem_Cnt));
 {$ENDIF}
-  if not UpdateNeeded(OnlyInterfaceNeeded) then exit;
 {$IFDEF CTDEBUG}
-writeln('TPascalParserTool.BuildTree B');
+writeln('TPascalParserTool.BuildTree A');
 {$ENDIF}
+  if not UpdateNeeded(OnlyInterfaceNeeded) then exit;
+writeln('TPascalParserTool.BuildTree B OnlyInterfaceNeeded=',OnlyInterfaceNeeded,
+  '  ',TCodeBuffer(Scanner.MainCode).Filename);
 //CheckHeap('TBasicCodeTool.BuildTree B '+IntToStr(GetMem_Cnt));
   BeginParsing(true,OnlyInterfaceNeeded);
   InterfaceSectionFound:=false;

components/codetools/sourcelog.pas

@@ -659,8 +659,10 @@ end;
 
 procedure TSourceLog.IncreaseChangeStep;
 begin
-  if FChangeStep=$7fffffff then FChangeStep:=-$7fffffff
-  else inc(FChangeStep);
+  if FChangeStep<>$7fffffff then
+    inc(FChangeStep)
+  else
+    FChangeStep:=-$7fffffff;
 //writeln('[TSourceLog.IncreaseChangeStep] ',FChangeStep,',',HexStr(Cardinal(Self),8));
 end;