From 6f4f1d0688fb75be0e3a340a92cbc08f84bfa1af Mon Sep 17 00:00:00 2001 From: lazarus Date: Wed, 30 Jan 2002 15:40:48 +0000 Subject: [PATCH] MG: added global write lock git-svn-id: trunk@647 - --- components/codetools/codetoolmanager.pas | 38 ++++++ components/codetools/customcodetool.pas | 5 +- components/codetools/finddeclarationtool.pas | 128 ++++++++++--------- components/codetools/linkscanner.pas | 45 +++++++ components/codetools/pascalparsertool.pas | 9 +- components/codetools/sourcelog.pas | 6 +- 6 files changed, 161 insertions(+), 70 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 787c4b2be5..423a53bf21 100644 --- a/components/codetools/codetoolmanager.pas +++ b/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 diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 669670200b..b998bba9b0 100644 --- a/components/codetools/customcodetool.pas +++ b/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; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 137826fd9a..d738366172 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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; diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index fb165d9c69..3b92f25b99 100644 --- a/components/codetools/linkscanner.pas +++ b/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; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 71ac3837f4..028d1e6414 100644 --- a/components/codetools/pascalparsertool.pas +++ b/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; diff --git a/components/codetools/sourcelog.pas b/components/codetools/sourcelog.pas index aeecc68cd6..c6706686b6 100644 --- a/components/codetools/sourcelog.pas +++ b/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;