From 40381b37f5ccad2b3fadf41b8e463e387b3dd3b1 Mon Sep 17 00:00:00 2001 From: egrange Date: Thu, 13 Jun 2024 16:40:15 +0200 Subject: [PATCH] Misc. micro optimizations for compiler --- Source/dwsCompiler.pas | 20 ++++++----- Source/dwsConvExprs.pas | 7 ++-- Source/dwsSymbols.pas | 22 +++++++----- Source/dwsTokenizer.pas | 77 ++++++++++++++++++++++------------------- Source/dwsUtils.pas | 4 +-- 5 files changed, 72 insertions(+), 58 deletions(-) diff --git a/Source/dwsCompiler.pas b/Source/dwsCompiler.pas index 1ec80ef9..ca589522 100644 --- a/Source/dwsCompiler.pas +++ b/Source/dwsCompiler.pas @@ -1104,32 +1104,36 @@ function TStandardSymbolFactory.ReadInitExpr(expecting : TTypeSymbol = nil) : TT end; begin - if expecting<>nil then begin + if expecting <> nil then begin case FCompiler.Tokenizer.TestAny([ttBLEFT, ttALEFT]) of - ttBLEFT : - if expecting.ClassType=TRecordSymbol then begin + ttBLEFT : begin + var expectingClassType := expecting.ClassType; + if expectingClassType = TRecordSymbol then begin Result := ReadConstRecordInitExpr(TRecordSymbol(expecting)); Exit; - end else if expecting is TArraySymbol then begin + end else if expectingClassType.InheritsFrom(TArraySymbol) then begin FCompiler.Tokenizer.KillToken; Result := ReadArrayConstantExpr(ttBRIGHT, expecting); Exit; end; - ttALEFT : - if expecting is TArraySymbol then begin + end; + ttALEFT :begin + var expectingClassType := expecting.ClassType; + if expectingClassType.InheritsFrom(TArraySymbol) then begin FCompiler.Tokenizer.KillToken; Result := ReadArrayConstantExpr(ttARIGHT, expecting); Exit; - end else if expecting is TSetOfSymbol then begin + end else if expectingClassType = TSetOfSymbol then begin FCompiler.Tokenizer.KillToken; Result := ReadArrayConstantExpr(ttARIGHT, expecting); Result := TConvExpr.WrapWithConvCast(FCompiler.FCompilerContext, FCompiler.Tokenizer.HotPos, expecting, Result, CPE_IncompatibleTypes); Exit; end; + end; end; end; - Result:=ReadExpr(expecting) + Result := ReadExpr(expecting) end; // ------------------ diff --git a/Source/dwsConvExprs.pas b/Source/dwsConvExprs.pas index bd5e4d09..d265497a 100644 --- a/Source/dwsConvExprs.pas +++ b/Source/dwsConvExprs.pas @@ -277,13 +277,14 @@ class function TConvExpr.WrapWithConvCast(context : TdwsCompilerContext; const s if expr.ClassType = TArrayConstantExpr then begin - arrayConst:=TArrayConstantExpr(expr); - if toTyp is TDynamicArraySymbol then begin + arrayConst := TArrayConstantExpr(expr); + var toTypClass := toTyp.ClassType; + if toTypClass = TDynamicArraySymbol then begin if (toTyp.Typ.IsOfType(expr.Typ.Typ)) or ((arrayConst.ElementCount=0) and (arrayConst.Typ.Typ.IsOfType(context.TypVariant))) then Result:=TConvArrayConstantToDynamicExpr.Create(context, scriptPos, arrayConst, TDynamicArraySymbol(toTyp)) - end else if toTyp is TSetOfSymbol then begin + end else if toTypClass = TSetOfSymbol then begin if arrayConst.ElementCount=0 then begin Result:=TConstExpr.Create(cNullPos, toTyp); expr.Free; diff --git a/Source/dwsSymbols.pas b/Source/dwsSymbols.pas index 745c8c07..d8d530f4 100644 --- a/Source/dwsSymbols.pas +++ b/Source/dwsSymbols.pas @@ -1185,7 +1185,7 @@ TBaseSymbol = class(TTypeSymbol) function SpecializeType(const context : ISpecializationContext) : TTypeSymbol; override; end; - TBaseIntegerSymbol = class (TBaseSymbol) + TBaseIntegerSymbol = class sealed (TBaseSymbol) public constructor Create; @@ -1193,14 +1193,14 @@ TBaseIntegerSymbol = class (TBaseSymbol) function IsCompatible(typSym : TTypeSymbol) : Boolean; override; end; - TBaseFloatSymbol = class (TBaseSymbol) + TBaseFloatSymbol = class sealed (TBaseSymbol) public constructor Create; procedure InitDataContext(const data : IDataContext; offset : NativeInt); override; end; - TBaseStringSymbol = class (TBaseSymbol) + TBaseStringSymbol = class sealed (TBaseSymbol) private FLengthPseudoSymbol : TPseudoMethodSymbol; FHighPseudoSymbol : TPseudoMethodSymbol; @@ -1220,7 +1220,7 @@ TBaseStringSymbol = class (TBaseSymbol) function LowPseudoSymbol(baseSymbols : TdwsBaseSymbolsContext) : TPseudoMethodSymbol; inline; end; - TBaseBooleanSymbol = class (TBaseSymbol) + TBaseBooleanSymbol = class sealed (TBaseSymbol) public constructor Create; @@ -6917,7 +6917,9 @@ function TSymbolTable.FindLocal(const aName : String) : TSymbol; ptrList := FSymbols.List; while lo <= hi do begin mid := (lo + hi) shr 1; + {$IFOPT R+}{$DEFINE RANGEON}{$R-}{$ELSE}{$UNDEF RANGEON}{$ENDIF} Result := TSymbol(ptrList[mid]); + {$IFDEF RANGEON}{$R+}{$UNDEF RANGEON}{$ENDIF} cmpResult := UnicodeCompareText(Result.Name, aName); if cmpResult < 0 then lo := mid+1 @@ -7049,7 +7051,9 @@ function TSymbolTable.EnumerateLocalSymbolsOfName( var list := FSymbols.List; var nameLen := Length(aName); for var i := 0 to Count-1 do begin + {$IFOPT R+}{$DEFINE RANGEON}{$R-}{$ELSE}{$UNDEF RANGEON}{$ENDIF} var sym := TSymbol(list[i]); + {$IFDEF RANGEON}{$R+}{$UNDEF RANGEON}{$ENDIF} if (Length(sym.Name) = nameLen) and ( (nameLen = 0) @@ -7095,15 +7099,15 @@ function TSymbolTable.EnumerateSymbolsOfNameInScope(const aName : String; // function TSymbolTable.EnumerateLocalHelpers(helpedType : TTypeSymbol; const callback : THelperSymbolEnumerationCallback) : Boolean; var - i : Integer; - sym : TSymbol; list : PObjectTightList; begin if stfHasHelpers in FFlags then begin list := FSymbols.List; - for i:=0 to FSymbols.Count-1 do begin - sym:=TSymbol(list[i]); - if sym.ClassType=THelperSymbol then + for var i := 0 to FSymbols.Count-1 do begin + {$IFOPT R+}{$DEFINE RANGEON}{$R-}{$ELSE}{$UNDEF RANGEON}{$ENDIF} + var sym := TSymbol(list[i]); + {$IFDEF RANGEON}{$R+}{$UNDEF RANGEON}{$ENDIF} + if sym.ClassType = THelperSymbol then if THelperSymbol(sym).HelpsType(helpedType) then begin if callback(THelperSymbol(sym)) then Exit(True); end; diff --git a/Source/dwsTokenizer.pas b/Source/dwsTokenizer.pas index fd890984..50832bfd 100644 --- a/Source/dwsTokenizer.pas +++ b/Source/dwsTokenizer.pas @@ -24,8 +24,8 @@ interface uses - SysUtils, Classes, TypInfo, - dwsTokenTypes, dwsScriptSource, dwsErrors, dwsStrings, dwsXPlatform, dwsUtils, dwsXXHash + System.SysUtils, System.Classes, System.TypInfo, + dwsTokenTypes, dwsScriptSource, dwsErrors, dwsUtils {$ifdef FPC},lazutf8{$endif}; type @@ -200,13 +200,13 @@ TTokenizerRules = class end; TTokenizerSourceInfo = record + FHotPos : TScriptPos; + FCurPos : TScriptPos; + FPosPtr : PChar; FPathName : TFileName; FLocation : TFileName; FText : String; FDefaultPos : TScriptPos; - FHotPos : TScriptPos; - FCurPos : TScriptPos; - FPosPtr : PChar; end; PTokenizerSourceInfo = ^TTokenizerSourceInfo; @@ -222,23 +222,27 @@ TTokenizerConditionalInfo = record TTokenizer = class private FTokenBuf : TTokenBuffer; - FNextToken : TToken; - FRules : TTokenizerRules; + FOnBeforeAction : TTokenizerActionEvent; FStartState : TState; - FToken : TToken; FSource : TTokenizerSourceInfo; + + FOnEndSourceFile : TTokenizerEndSourceFileEvent; + + FToken : TToken; + FNextToken : TToken; + + FRules : TTokenizerRules; + FTokenPool : TToken; + FSwitchHandler : TSwitchHandler; FSwitchProcessor : TSwitchHandler; + + FSourceStack : array of TTokenizerSourceInfo; + FMsgs : TdwsCompileMessageList; FConditionalDefines : IAutoStrings; FConditionalDepth : TSimpleStack; - FTokenPool : TToken; - - FSourceStack : array of TTokenizerSourceInfo; - FOnEndSourceFile : TTokenizerEndSourceFileEvent; - FOnBeforeAction : TTokenizerActionEvent; - procedure AllocateToken; procedure ReleaseToken; @@ -315,6 +319,8 @@ implementation // ------------------------------------------------------------------ // ------------------------------------------------------------------ +uses dwsXPlatform, dwsStrings; + const cFormatSettings : TFormatSettings = ( DecimalSeparator : {%H-}'.' ); @@ -327,12 +333,14 @@ function TTokenRecord.EmptyString : Boolean; // AppendChar // +{$IFOPT R+}{$DEFINE RANGEON}{$R-}{$ELSE}{$UNDEF RANGEON}{$ENDIF} procedure TTokenBuffer.AppendChar(c : Char); begin - if Len>=Capacity then Grow; - Buffer[Len]:=c; + if Len >= Capacity then Grow; + Buffer[Len] := c; Inc(Len); end; +{$IFDEF RANGEON}{$R+}{$UNDEF RANGEON}{$ENDIF} // Grow // @@ -927,45 +935,42 @@ procedure PrepareAlphaToTokenType; // UpperMatchLen // function TTokenBuffer.UpperMatchLen(const str : String) : Boolean; -var - i : Integer; - p : PChar; - ch : Char; begin - p:=PChar(Pointer(str)); - for i:=1 to Len-1 do begin - ch:=Buffer[i]; + var p := PChar(Pointer(str)); + for var i := 1 to Len-1 do begin + var ch := Buffer[i]; case ch of - 'a'..'z' : if Char(Word(ch) xor $0020)<>p[i] then Exit(False); + 'a'..'z' : if Char(Word(ch) xor $0020) <> p[i] then Exit(False); else - if ch<>p[i] then Exit(False); + if ch <> p[i] then Exit(False); end; end; - Result:=True; + Result := True; end; // ToAlphaType // +{$IFOPT R+}{$DEFINE RANGEON}{$R-}{$ELSE}{$UNDEF RANGEON}{$ENDIF} function TTokenBuffer.ToAlphaType : TTokenType; var - ch : Char; - i : Integer; - lookups : PTokenAlphaLookups; + lookups : Pointer; begin if (Len<2) or (Len>14) then Exit(ttNAME); - ch:=Buffer[0]; + var ch := Buffer[0]; case ch of - 'a'..'x' : lookups:=@vAlphaToTokenType[Len][Char(Word(ch) xor $0020)]; - 'A'..'X' : lookups:=@vAlphaToTokenType[Len][ch]; + 'a'..'x' : lookups := @vAlphaToTokenType[Len][Char(Word(ch) xor $0020)]; + 'A'..'X' : lookups := @vAlphaToTokenType[Len][ch]; else Exit(ttNAME); end; - for i:=0 to High(lookups^) do begin - if UpperMatchLen(lookups^[i].Alpha) then - Exit(lookups^[i].Token); + lookups := PPointer(lookups)^; + for var i := 0 to High(TTokenAlphaLookups(lookups)) do begin + if UpperMatchLen(TTokenAlphaLookups(lookups)[i].Alpha) then + Exit(TTokenAlphaLookups(lookups)[i].Token); end; - Result:=ttNAME; + Result := ttNAME; end; +{$IFDEF RANGEON}{$R+}{$UNDEF RANGEON}{$ENDIF} // MatchLen // diff --git a/Source/dwsUtils.pas b/Source/dwsUtils.pas index 2fd2b249..926f9845 100644 --- a/Source/dwsUtils.pas +++ b/Source/dwsUtils.pas @@ -3785,10 +3785,10 @@ function UnicodeCompareLen(p1, p2 : PWideChar; n : Integer) : Integer; if c1 <> c2 then begin if (c1 <= 127) and (c2 <= 127) then begin //if c1 in [Ord('a')..Ord('z')] then - if Cardinal(c1 - Ord('a')) <= Cardinal(Ord('z') - Ord('a')) then + if Cardinal(c1 - Ord('a')) <= Cardinal(Ord('z') - Ord('a')) then c1 := c1 + (Ord('A')-Ord('a')); // if c2 in [Ord('a')..Ord('z')] then - if Cardinal(c2 - Ord('a')) <= Cardinal(Ord('z') - Ord('a')) then + if Cardinal(c2 - Ord('a')) <= Cardinal(Ord('z') - Ord('a')) then c2 := c2 + (Ord('A')-Ord('a')); if c1 <> c2 then begin Result := c1 - c2;