diff --git a/components/codetools/codetoolsstructs.pas b/components/codetools/codetoolsstructs.pas index c8eca70078..3466567464 100644 --- a/components/codetools/codetoolsstructs.pas +++ b/components/codetools/codetoolsstructs.pas @@ -112,6 +112,8 @@ type procedure Clear; function Contains(const s: string): boolean; function GetString(const Name: string; out Value: string): boolean; + procedure Add(const Name, Value: string); + procedure GetNames(List: TStrings); procedure Remove(const Name: string); property Strings[const s: string]: string read GetStrings write SetStrings; default; property CaseSensitive: boolean read FCaseSensitive; @@ -387,6 +389,24 @@ begin end; end; +procedure TStringToStringTree.Add(const Name, Value: string); +begin + Strings[Name]:=Value; +end; + +procedure TStringToStringTree.GetNames(List: TStrings); +var + Node: TAVLTreeNode; + Item: PStringToStringTreeItem; +begin + Node:=Tree.FindLowest; + while Node<>nil do begin + Item:=PStringToStringTreeItem(Node.Data); + List.Add(Item^.Name); + Node:=Tree.FindSuccessor(Node); + end; +end; + procedure TStringToStringTree.Remove(const Name: string); var Node: TAVLTreeNode; diff --git a/components/codetools/directivestree.pas b/components/codetools/directivestree.pas index bd5a3a2c43..046837f1c0 100644 --- a/components/codetools/directivestree.pas +++ b/components/codetools/directivestree.pas @@ -99,6 +99,39 @@ type constructor Create(ASender: TCompilerDirectivesTree; const AMessage: string); end; + TCompilerMacroStatus = ( + cmsUnknown, // never seen + cmsDefined, // set to a specific value e.g. by $Define or by $IfDef + cmsUndefined, // undefined e.g. by $Undef + cmsComplex // value depends on complex expressions. e.g. {$if A or B}. + ); + + TCompilerMacroStats = class + public + Name: string; + Value: string; + Status: TCompilerMacroStatus; + LastDefineNode: TCodeTreeNode;// define or undef node + LastReadNode: TCodeTreeNode;// if node + end; + + { TH2PasFunction } + + TH2PasFunction = class + public + Name: string; + HeaderStart: integer; + HeaderEnd: integer; + BeginStart: integer; + BeginEnd: integer; + IsForward: boolean; + IsExternal: boolean; + InInterface: boolean; + DefNode: TH2PasFunction;// the corresponding node + function NeedsBody: boolean; + procedure AdjustPositionsAfterInsert(FromPos, ToPos, DiffPos: integer); + end; + { TCompilerDirectivesTree } TCompilerDirectivesTree = class @@ -233,39 +266,6 @@ type property ChangeStep: integer read FChangeStep; end; - TCompilerMacroStatus = ( - cmsUnknown, // never seen - cmsDefined, // set to a specific value e.g. by $Define or by $IfDef - cmsUndefined, // undefined e.g. by $Undef - cmsComplex // value depends on complex expressions. e.g. {$if A or B}. - ); - - TCompilerMacroStats = class - public - Name: string; - Value: string; - Status: TCompilerMacroStatus; - LastDefineNode: TCodeTreeNode;// define or undef node - LastReadNode: TCodeTreeNode;// if node - end; - - { TH2PasFunction } - - TH2PasFunction = class - public - Name: string; - HeaderStart: integer; - HeaderEnd: integer; - BeginStart: integer; - BeginEnd: integer; - IsForward: boolean; - IsExternal: boolean; - InInterface: boolean; - DefNode: TH2PasFunction;// the corresponding node - function NeedsBody: boolean; - procedure AdjustPositionsAfterInsert(FromPos, ToPos, DiffPos: integer); - end; - function CompareCompilerMacroStats(Data1, Data2: Pointer): integer; function ComparePCharWithCompilerMacroStats(Name, MacroStats: Pointer): integer; function CompareH2PasFuncByNameAndPos(Data1, Data2: Pointer): integer; @@ -1836,7 +1836,7 @@ begin Node:=Tree.Root; while Node<>nil do begin NextNode:=Node.Next; - + case Node.Desc of cdnIf,cdnElseIf: if GetIfExpression(Node,ExprStart,ExprEnd) then begin diff --git a/components/codetools/h2pastool.pas b/components/codetools/h2pastool.pas index 1a559ac5d5..7899854fb5 100644 --- a/components/codetools/h2pastool.pas +++ b/components/codetools/h2pastool.pas @@ -43,9 +43,10 @@ unit H2PasTool; interface uses - Classes, SysUtils, contnrs, AVL_Tree, - FileProcs, BasicCodeTools, CCodeParserTool, NonPascalCodeTools, - KeywordFuncLists, CodeCache, CodeTree, CodeAtom; + Classes, SysUtils, CodeToolsStructs, AVL_Tree, + FileProcs, DirectivesTree, BasicCodeTools, CCodeParserTool, + NonPascalCodeTools, KeywordFuncLists, CodeCache, + CodeTree, CodeAtom; const DefaultMaxPascalIdentLen = 70; @@ -67,9 +68,6 @@ const h2pdnError = 31+h2pdnBase; type - TH2PNode = class; - - { TH2PBaseNode } TH2PBaseNode = class @@ -87,6 +85,7 @@ type CTool: TCCodeParserTool = nil); virtual; end; + TH2PNode = class; { TH2PDirectiveNode } @@ -136,23 +135,42 @@ type procedure WriteDebugReport(WithChilds: boolean); end; - + + TH2PMacroStatus = ( + hmsUnknown, // never seen + hmsDefined, // set to a specific value e.g. by $Define or by $IfDef + hmsUndefined, // undefined e.g. by $Undef + hmsComplex // value depends on complex expressions. e.g. {$if A or B}. + ); + + TH2PMacroStats = class + public + Name: string; + Value: string; + Status: TH2PMacroStatus; + end; + + TIgnoreCSourcePart = ( icspInclude ); TIgnoreCSourceParts = set of TIgnoreCSourcePart; - - + { TH2PasTool } TH2PasTool = class private + FDefines: TStringToStringTree; + FDisableUnusedDefines: boolean; FIgnoreCParts: TIgnoreCSourceParts; - FPredefinedCTypes: TFPStringHashTable; + FPredefinedCTypes: TStringToStringTree; FPascalNames: TAVLTree;// tree of TH2PNode sorted for PascalName FCNames: TAVLTree;// tree of TH2PNode sorted for CName + FRemoveDisabledDirectives: boolean; + FSimplifyExpressions: boolean; FSourceName: string; FCurDirectiveNode: TH2PDirectiveNode; + FUndefines: TStringToStringTree; procedure ConvertStruct(CNode: TCodeTreeNode; ParentNode: TH2PNode); procedure ConvertVariable(CNode: TCodeTreeNode; ParentNode: TH2PNode); procedure ConvertEnumBlock(CNode: TCodeTreeNode; ParentNode: TH2PNode); @@ -170,6 +188,7 @@ type Tree: TH2PTree; // TH2PNode DirectivesTree: TH2PTree; // TH2PDirectiveNode CTool: TCCodeParserTool; + Macros: TAVLTree;// tree of TH2PMacroStats function Convert(CCode, PascalCode: TCodeBuffer): boolean; procedure BuildH2PTree(ParentNode: TH2PNode = nil; StartNode: TCodeTreeNode = nil); procedure SimplifyDirectives; @@ -204,17 +223,37 @@ type constructor Create; destructor Destroy; override; procedure Clear; - property PredefinedCTypes: TFPStringHashTable read FPredefinedCTypes; + property PredefinedCTypes: TStringToStringTree read FPredefinedCTypes; property IgnoreCParts: TIgnoreCSourceParts read FIgnoreCParts write FIgnoreCParts; property SourceName: string read FSourceName write FSourceName; + + // directives + property SimplifyExpressions: boolean read FSimplifyExpressions + write FSimplifyExpressions; + property DisableUnusedDefines: boolean read FDisableUnusedDefines + write FDisableUnusedDefines; + property RemoveDisabledDirectives: boolean read FRemoveDisabledDirectives + write FRemoveDisabledDirectives; + property Defines: TStringToStringTree read FDefines; + property Undefines: TStringToStringTree read FUndefines;// undefines take precedence over defines + + procedure ResetMacros; + procedure ClearMacros; + procedure InitMacros; + function FindMacro(const MacroName: string; + CreateIfNotExists: boolean = false): TH2PMacroStats; + function DefineMacro(const MacroName, AValue: string): TH2PMacroStats; + function UndefineMacro(const MacroName: string): TH2PMacroStats; end; -function DefaultPredefinedCTypes: TFPStringHashTable;// types in unit ctypes +function DefaultPredefinedCTypes: TStringToStringTree;// types in unit ctypes function CompareH2PNodePascalNames(Data1, Data2: Pointer): integer; function CompareStringWithH2PNodePascalName(AString, ANode: Pointer): integer; function CompareH2PNodeCNames(Data1, Data2: Pointer): integer; +function CompareH2PMacroStats(Data1, Data2: Pointer): integer; +function ComparePCharWithH2PMacroStats(Name, MacroStats: Pointer): integer; function H2PDirectiveNodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string; @@ -223,12 +262,12 @@ implementation var - InternalPredefinedCTypes: TFPStringHashTable = nil;// types in unit ctypes + InternalPredefinedCTypes: TStringToStringTree = nil;// types in unit ctypes -function DefaultPredefinedCTypes: TFPStringHashTable; +function DefaultPredefinedCTypes: TStringToStringTree; begin if InternalPredefinedCTypes=nil then begin - InternalPredefinedCTypes:=TFPStringHashTable.Create; + InternalPredefinedCTypes:=TStringToStringTree.Create(true); with InternalPredefinedCTypes do begin // int Add('int','cint'); @@ -339,6 +378,18 @@ begin PChar(Pointer(TH2PNode(Data2).CName))); end; +function CompareH2PMacroStats(Data1, Data2: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(Pointer(TH2PMacroStats(Data1).Name), + Pointer(TH2PMacroStats(Data2).Name)); +end; + +function ComparePCharWithH2PMacroStats(Name, MacroStats: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(Name, + Pointer(TH2PMacroStats(MacroStats).Name)); +end; + function H2PDirectiveNodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string; begin case Desc of @@ -1003,8 +1054,40 @@ begin end; procedure TH2PasTool.SimplifyDirectives; -begin +(* Check and improve the following cases + 1.a {$DEFINE Name} and Name is never used afterwards -> disable + 1.b {$DEFINE Name} + ... Name is not used here ... + {$DEFINE Name} + -> disable first + + 2. {$IFDEF Name}... only comments and spaces ...{$ENDIF} + -> disable the whole block + + 3. {$IFNDEF Name} + ... only comments and spaces ... + {$DEFINE Name} + ... only comments and spaces ... + {$ENDIF} + -> disable the IFNDEF and the ENDIF and keep the DEFINE +*) +var + Node: TH2PDirectiveNode; + NextNode: TH2PDirectiveNode; +begin + InitMacros; + Node:=TH2PDirectiveNode(DirectivesTree.Root); + while Node<>nil do begin + NextNode:=TH2PDirectiveNode(Node.Next); + case Node.Desc of + h2pdnIfDef, h2pdnIfNDef: + begin + + end; + end; + Node:=NextNode; + end; end; procedure TH2PasTool.WritePascal(PascalCode: TCodeBuffer); @@ -1757,6 +1840,8 @@ begin FPascalNames:=TAVLTree.Create(@CompareH2PNodePascalNames); FCNames:=TAVLTree.Create(@CompareH2PNodeCNames); FIgnoreCParts:=[icspInclude]; + FDefines:=TStringToStringTree.Create(true); + FUndefines:=TStringToStringTree.Create(true); end; destructor TH2PasTool.Destroy; @@ -1768,6 +1853,8 @@ begin FreeAndNil(FPascalNames); FreeAndNil(FCNames); FreeAndNil(CTool); + FreeAndNil(FDefines); + FreeAndNil(FUndefines); inherited Destroy; end; @@ -1777,6 +1864,91 @@ begin FCNames.Clear; Tree.Clear; DirectivesTree.Clear; + ClearMacros; + FDefines.Clear; + FUndefines.Clear; +end; + +procedure TH2PasTool.ResetMacros; +begin + if Macros<>nil then + Macros.FreeAndClear + else + Macros:=TAVLTree.Create(@CompareH2PMacroStats); +end; + +procedure TH2PasTool.ClearMacros; +begin + if Macros<>nil then begin + Macros.FreeAndClear; + FreeAndNil(Macros); + end; +end; + +procedure TH2PasTool.InitMacros; +var + List: TStringList; + i: Integer; + CurName: string; + CurValue: string; +begin + ResetMacros; + if FDefines<>nil then begin + List:=TStringList.Create; + FDefines.GetNames(List); + for i:=0 to List.Count-1 do begin + CurName:=List[i]; + CurValue:=FDefines[CurName]; + DefineMacro(CurName,CurValue); + end; + List.Free; + end; + if FUndefines<>nil then begin + List:=TStringList.Create; + FUndefines.GetNames(List); + for i:=0 to List.Count-1 do begin + CurName:=List[i]; + UndefineMacro(CurName); + end; + List.Free; + end; +end; + +function TH2PasTool.FindMacro(const MacroName: string; + CreateIfNotExists: boolean): TH2PMacroStats; +var + AVLNode: TAVLTreeNode; +begin + Result:=nil; + if Macros=nil then begin + if not CreateIfNotExists then + exit; + Macros:=TAVLTree.Create(@CompareH2PMacroStats); + end; + AVLNode:=Macros.FindKey(Pointer(MacroName), + @ComparePCharWithH2PMacroStats); + if AVLNode<>nil then + Result:=TH2PMacroStats(AVLNode.Data) + else if CreateIfNotExists then begin + Result:=TH2PMacroStats.Create; + Result.Name:=MacroName; + Result.Status:=hmsUnknown; + Macros.Add(Result); + end; +end; + +function TH2PasTool.DefineMacro(const MacroName, AValue: string): TH2PMacroStats; +begin + Result:=FindMacro(MacroName,true); + Result.Value:=AValue; + Result.Status:=hmsDefined; +end; + +function TH2PasTool.UndefineMacro(const MacroName: string): TH2PMacroStats; +begin + Result:=FindMacro(MacroName,true); + Result.Value:=''; + Result.Status:=hmsUndefined; end; { TH2PNode }