mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 04:29:29 +02:00
fcl-passrc: scanner: accelerated Macros
git-svn-id: trunk@36127 -
This commit is contained in:
Mattias Gaertner
parent
76734070c4
commit
fef47e05e0
@ -21,7 +21,7 @@ unit PScanner;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes;
|
||||
uses SysUtils, Classes, contnrs;
|
||||
|
||||
// message numbers
|
||||
const
|
||||
@ -244,18 +244,6 @@ type
|
||||
);
|
||||
TModeSwitches = Set of TModeSwitch;
|
||||
|
||||
{ TMacroDef }
|
||||
|
||||
TMacroDef = Class(TObject)
|
||||
Private
|
||||
FName: String;
|
||||
FValue: String;
|
||||
Public
|
||||
Constructor Create(Const AName,AValue : String);
|
||||
Property Name : String Read FName;
|
||||
Property Value : String Read FValue Write FValue;
|
||||
end;
|
||||
|
||||
{ TLineReader }
|
||||
|
||||
TLineReader = class
|
||||
@ -399,6 +387,32 @@ type
|
||||
Row, Column: Cardinal;
|
||||
end;
|
||||
|
||||
PPasNameValue = ^TPasNameValue;
|
||||
TPasNameValue = Record
|
||||
Name: String;
|
||||
Value: String;
|
||||
end;
|
||||
|
||||
{ TPasNameValues }
|
||||
|
||||
TPasNameValues = class
|
||||
private
|
||||
FChangeStamp: integer;
|
||||
FList: TFPHashList; // list of PPasNameValue
|
||||
procedure OnClearItem(Item, Dummy: pointer);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function Define(const Name: String; const Value: String = ''): PPasNameValue;
|
||||
function UnDefine(const Name: String): boolean;
|
||||
function Find(const Name: String): PPasNameValue;
|
||||
function IsDefined(const Name: String): boolean; inline;
|
||||
property ChangeStamp: integer read FChangeStamp;
|
||||
procedure Modified; inline;
|
||||
property List: TFPHashList read FList;
|
||||
end;
|
||||
|
||||
type
|
||||
{ TPascalScanner }
|
||||
|
||||
@ -423,7 +437,7 @@ type
|
||||
FCurToken: TToken;
|
||||
FCurTokenString: string;
|
||||
FCurLine: string;
|
||||
FMacros,
|
||||
FMacros: TPasNameValues;
|
||||
FDefines: TStrings;
|
||||
FOptions: TPOptions;
|
||||
FLogEvents: TPScannerLogEvents;
|
||||
@ -466,7 +480,7 @@ type
|
||||
function HandleInclude(const Param: String): TToken;virtual;
|
||||
procedure HandleMode(const Param: String);virtual;
|
||||
procedure HandleModeSwitch(const Param: String);virtual;
|
||||
function HandleMacro(AIndex: integer): TToken;virtual;
|
||||
function HandleMacro(aMacro: PPasNameValue): TToken;virtual;
|
||||
procedure PushStackItem; virtual;
|
||||
function DoFetchTextToken: TToken;
|
||||
function DoFetchToken: TToken;
|
||||
@ -480,9 +494,11 @@ type
|
||||
procedure OpenFile(const AFilename: string);
|
||||
function FetchToken: TToken;
|
||||
function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
|
||||
Procedure AddDefine(S : String);
|
||||
Procedure RemoveDefine(S : String);
|
||||
Procedure SetCompilerMode(S : String);
|
||||
Procedure AddDefine(aName: String);
|
||||
Procedure RemoveDefine(const aName: String);
|
||||
Procedure UnDefine(const aName: String); // remove form Defines and Macros
|
||||
function IsDefined(const aName: String): boolean; // check Defines and Macros
|
||||
Procedure SetCompilerMode(const S: String);
|
||||
function CurSourcePos: TPasSourcePos;
|
||||
Function SetForceCaret(AValue : Boolean) : Boolean;
|
||||
|
||||
@ -500,7 +516,7 @@ type
|
||||
Property PreviousToken : TToken Read FPreviousToken;
|
||||
|
||||
property Defines: TStrings read FDefines;
|
||||
property Macros: TStrings read FMacros;
|
||||
property Macros: TPasNameValues read FMacros;
|
||||
Property Options : TPOptions Read FOptions Write SetOptions;
|
||||
Property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
|
||||
Property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
|
||||
@ -882,12 +898,90 @@ begin
|
||||
Result:=(TheFilename<>'') and (TheFilename[1]='/');
|
||||
end;
|
||||
|
||||
{ TMacroDef }
|
||||
{ TPasNameValues }
|
||||
|
||||
constructor TMacroDef.Create(const AName, AValue: String);
|
||||
// inline
|
||||
function TPasNameValues.IsDefined(const Name: String): boolean;
|
||||
begin
|
||||
FName:=AName;
|
||||
FValue:=AValue;
|
||||
Result:=Find(Name)<>nil;
|
||||
end;
|
||||
|
||||
// inline
|
||||
procedure TPasNameValues.Modified;
|
||||
begin
|
||||
if FChangeStamp=High(FChangeStamp) then
|
||||
FChangeStamp:=Low(FChangeStamp)+1
|
||||
else
|
||||
inc(FChangeStamp);
|
||||
end;
|
||||
|
||||
procedure TPasNameValues.OnClearItem(Item, Dummy: pointer);
|
||||
var
|
||||
NameValue: PPasNameValue absolute Item;
|
||||
begin
|
||||
if Dummy=nil then ;
|
||||
Dispose(NameValue);
|
||||
end;
|
||||
|
||||
constructor TPasNameValues.Create;
|
||||
begin
|
||||
FList:=TFPHashList.Create;
|
||||
end;
|
||||
|
||||
destructor TPasNameValues.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPasNameValues.Clear;
|
||||
begin
|
||||
if FList.Count=0 then exit;
|
||||
FList.ForEachCall(@OnClearItem,nil);
|
||||
FList.Clear;
|
||||
Modified;
|
||||
end;
|
||||
|
||||
function TPasNameValues.Define(const Name: String; const Value: String
|
||||
): PPasNameValue;
|
||||
var
|
||||
Item: PPasNameValue;
|
||||
begin
|
||||
Item:=Find(Name);
|
||||
if Item<>nil then
|
||||
begin
|
||||
if Item^.Value=Value then exit(Item);
|
||||
Item^.Value:=Value;
|
||||
end
|
||||
else
|
||||
begin
|
||||
New(Item);
|
||||
Item^.Name:=Name;
|
||||
Item^.Value:=Value;
|
||||
FList.Add(uppercase(Name),Item);
|
||||
end;
|
||||
Modified;
|
||||
Result:=Item;
|
||||
end;
|
||||
|
||||
function TPasNameValues.UnDefine(const Name: String): boolean;
|
||||
var
|
||||
Item: PPasNameValue;
|
||||
Index: Integer;
|
||||
begin
|
||||
Index:=FList.FindIndexOf(uppercase(Name));
|
||||
if Index<0 then exit(false);
|
||||
Item:=PPasNameValue(FList.List^[Index].Data);
|
||||
FList.Delete(Index);
|
||||
Dispose(Item);
|
||||
Modified;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPasNameValues.Find(const Name: String): PPasNameValue;
|
||||
begin
|
||||
Result:=PPasNameValue(FList.Find(uppercase(Name)));
|
||||
end;
|
||||
|
||||
{ TStreamResolver }
|
||||
@ -1246,7 +1340,7 @@ begin
|
||||
FFileResolver := AFileResolver;
|
||||
FIncludeStack := TFPList.Create;
|
||||
FDefines := CS;
|
||||
FMacros:=CS;
|
||||
FMacros:=TPasNameValues.Create;
|
||||
FCurrentModeSwitches:=FPCModeSwitches;
|
||||
FAllowedModeSwitches:=msAllFPCModeSwitches;
|
||||
end;
|
||||
@ -1275,13 +1369,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.ClearMacros;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FMacros.Count-1 do
|
||||
FMacros.Objects[i].Free;
|
||||
FMacros.Clear;
|
||||
end;
|
||||
|
||||
@ -1555,16 +1643,14 @@ begin
|
||||
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FCurFileName],True);
|
||||
end;
|
||||
|
||||
function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
|
||||
function TPascalScanner.HandleMacro(aMacro: PPasNameValue): TToken;
|
||||
|
||||
Var
|
||||
M : TMacroDef;
|
||||
ML : TMacroReader;
|
||||
|
||||
begin
|
||||
PushStackItem;
|
||||
M:=FMacros.Objects[AIndex] as TMacroDef;
|
||||
ML:=TMacroReader.Create(FCurFileName,M.Value);
|
||||
ML:=TMacroReader.Create(FCurFileName,aMacro^.Value);
|
||||
ML.CurRow:=FCurRow;
|
||||
ML.CurCol:=CurColumn;
|
||||
FCurSourceFile:=ML;
|
||||
@ -1576,7 +1662,7 @@ procedure TPascalScanner.HandleDefine(Param: String);
|
||||
|
||||
Var
|
||||
Index : Integer;
|
||||
MN,MV : String;
|
||||
MName,MValue : String;
|
||||
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
@ -1585,14 +1671,10 @@ begin
|
||||
AddDefine(Param)
|
||||
else
|
||||
begin
|
||||
MV:=Trim(Param);
|
||||
MN:=Trim(Copy(MV,1,Index-1));
|
||||
Delete(MV,1,Index+1);
|
||||
Index:=FMacros.IndexOf(MN);
|
||||
If (Index=-1) then
|
||||
FMacros.AddObject(MN,TMacroDef.Create(MN,MV))
|
||||
else
|
||||
TMacroDef(FMacros.Objects[index]).Value:=MV;
|
||||
MValue:=Trim(Param);
|
||||
MName:=Trim(Copy(MValue,1,Index-1));
|
||||
Delete(MValue,1,Index+1);
|
||||
FMacros.Define(MName,MValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1602,24 +1684,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.HandleUnDefine(Param: String);
|
||||
|
||||
Var
|
||||
Index : integer;
|
||||
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
Index:=FDefines.IndexOf(Param);
|
||||
If (Index>=0) then
|
||||
RemoveDefine(Param)
|
||||
else
|
||||
begin
|
||||
Index := FMacros.IndexOf(Param);
|
||||
If (Index>=0) then
|
||||
begin
|
||||
FMacros.Objects[Index].FRee;
|
||||
FMacros.Delete(Index);
|
||||
end;
|
||||
end;
|
||||
UnDefine(Param);
|
||||
end;
|
||||
|
||||
function TPascalScanner.HandleInclude(const Param: String): TToken;
|
||||
@ -1724,27 +1790,19 @@ end;
|
||||
|
||||
procedure TPascalScanner.HandleIFDEF(const AParam: String);
|
||||
|
||||
Var
|
||||
ADefine : String;
|
||||
Index : Integer;
|
||||
|
||||
begin
|
||||
PushSkipMode;
|
||||
if PPIsSkipping then
|
||||
PPSkipMode := ppSkipAll
|
||||
else
|
||||
begin
|
||||
ADefine := UpperCase(AParam);
|
||||
Index := Defines.IndexOf(ADefine);
|
||||
if Index < 0 then
|
||||
Index := Macros.IndexOf(ADefine);
|
||||
if Index < 0 then
|
||||
if IsDefined(UpperCase(AParam)) then
|
||||
PPSkipMode := ppSkipElseBranch
|
||||
else
|
||||
begin
|
||||
PPSkipMode := ppSkipIfBranch;
|
||||
PPIsSkipping := true;
|
||||
end
|
||||
else
|
||||
PPSkipMode := ppSkipElseBranch;
|
||||
end;
|
||||
If LogEvent(sleConditionals) then
|
||||
if PPSkipMode=ppSkipElseBranch then
|
||||
DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
|
||||
@ -1755,28 +1813,19 @@ end;
|
||||
|
||||
procedure TPascalScanner.HandleIFNDEF(const AParam: String);
|
||||
|
||||
Var
|
||||
ADefine : String;
|
||||
Index : Integer;
|
||||
|
||||
begin
|
||||
PushSkipMode;
|
||||
if PPIsSkipping then
|
||||
PPSkipMode := ppSkipAll
|
||||
else
|
||||
begin
|
||||
ADefine := UpperCase(AParam);
|
||||
Index := Defines.IndexOf(ADefine);
|
||||
// Not sure about this
|
||||
if Index < 0 then
|
||||
Index := Macros.IndexOf(ADefine);
|
||||
if Index >= 0 then
|
||||
if IsDefined(UpperCase(AParam)) then
|
||||
PPSkipMode := ppSkipElseBranch
|
||||
else
|
||||
begin
|
||||
PPSkipMode := ppSkipIfBranch;
|
||||
PPIsSkipping := true;
|
||||
end
|
||||
else
|
||||
PPSkipMode := ppSkipElseBranch;
|
||||
end;
|
||||
If LogEvent(sleConditionals) then
|
||||
if PPSkipMode=ppSkipElseBranch then
|
||||
DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
|
||||
@ -1901,7 +1950,8 @@ function TPascalScanner.DoFetchToken: TToken;
|
||||
var
|
||||
TokenStart: PChar;
|
||||
i: TToken;
|
||||
OldLength, SectionLength, NestingLevel, Index: Integer;
|
||||
OldLength, SectionLength, NestingLevel: Integer;
|
||||
MacroValue: PPasNameValue;
|
||||
begin
|
||||
result:=tkLineEnding;
|
||||
if TokenStr = nil then
|
||||
@ -2314,11 +2364,11 @@ begin
|
||||
FCurToken := Result;
|
||||
exit;
|
||||
end;
|
||||
Index:=FMacros.IndexOf(CurtokenString);
|
||||
if (Index=-1) then
|
||||
MacroValue:=FMacros.Find(CurTokenString);
|
||||
if (MacroValue=nil) then
|
||||
Result := tkIdentifier
|
||||
else
|
||||
Result:=HandleMacro(index);
|
||||
Result:=HandleMacro(MacroValue);
|
||||
end;
|
||||
else
|
||||
if PPIsSkipping then
|
||||
@ -2423,25 +2473,37 @@ begin
|
||||
CreateMsgArgs(FLastMsgArgs,Args);
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.AddDefine(S: String);
|
||||
procedure TPascalScanner.AddDefine(aName: String);
|
||||
|
||||
begin
|
||||
If FDefines.IndexOf(S)=-1 then
|
||||
FDefines.Add(S);
|
||||
aName:=UpperCase(aName);
|
||||
If FDefines.IndexOf(aName)=-1 then
|
||||
FDefines.Add(aName);
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.RemoveDefine(S: String);
|
||||
procedure TPascalScanner.RemoveDefine(const aName: String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
Index : Integer;
|
||||
|
||||
begin
|
||||
I:=FDefines.IndexOf(S);
|
||||
if (I<>-1) then
|
||||
FDefines.Delete(I);
|
||||
Index:=FDefines.IndexOf(UpperCase(aName));
|
||||
If (Index>=0) then
|
||||
FDefines.Delete(Index);
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.SetCompilerMode(S: String);
|
||||
procedure TPascalScanner.UnDefine(const aName: String);
|
||||
begin
|
||||
RemoveDefine(aName);
|
||||
Macros.UnDefine(aName);
|
||||
end;
|
||||
|
||||
function TPascalScanner.IsDefined(const aName: String): boolean;
|
||||
begin
|
||||
Result:=(FDefines.IndexOf(aName)>=0) or Macros.IsDefined(aName);
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.SetCompilerMode(const S: String);
|
||||
begin
|
||||
HandleMode(S);
|
||||
end;
|
||||
|
||||
@ -460,6 +460,7 @@ type
|
||||
Procedure TestPropertyReadAccessorFuncWrongResult;
|
||||
Procedure TestPropertyReadAccessorFuncWrongArgCount;
|
||||
Procedure TestPropertyReadAccessorFunc;
|
||||
// ToDo: read accessor allow ancestor of field
|
||||
Procedure TestPropertyWriteAccessorVarWrongType;
|
||||
Procedure TestPropertyWriteAccessorFuncNotProc;
|
||||
Procedure TestPropertyWriteAccessorProcWrongArgCount;
|
||||
|
||||
@ -44,7 +44,7 @@ type
|
||||
private
|
||||
FDoSpecial: Boolean;
|
||||
protected
|
||||
function HandleMacro(AIndex: integer): TToken;override;
|
||||
function HandleMacro(aMacro: PPasNameValue): TToken; override;
|
||||
Public
|
||||
Property DoSpecial : Boolean Read FDoSpecial Write FDoSpecial;
|
||||
end;
|
||||
@ -231,7 +231,7 @@ implementation
|
||||
|
||||
{ TTestingPascalScanner }
|
||||
|
||||
function TTestingPascalScanner.HandleMacro(AIndex: integer): TToken;
|
||||
function TTestingPascalScanner.HandleMacro(aMacro: PPasNameValue): TToken;
|
||||
begin
|
||||
if DoSpecial then
|
||||
begin
|
||||
@ -239,7 +239,7 @@ begin
|
||||
SetCurTokenstring('somethingweird');
|
||||
end
|
||||
else
|
||||
Result:=inherited HandleMacro(AIndex);
|
||||
Result:=inherited HandleMacro(aMacro);
|
||||
end;
|
||||
|
||||
{ TTestTokenFinder }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user