Skip to content

Commit

Permalink
Misc. micro optimizations for compiler
Browse files Browse the repository at this point in the history
  • Loading branch information
@EricGrange
EricGrange committed Jun 13, 2024
1 parent 6d3a857 commit 40381b3
Show file tree
Hide file tree
Showing 5 changed files with 72 additions and 58 deletions.
20 changes: 12 additions & 8 deletions Source/dwsCompiler.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;

// ------------------
Expand Down
7 changes: 4 additions & 3 deletions Source/dwsConvExprs.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
22 changes: 13 additions & 9 deletions Source/dwsSymbols.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1185,22 +1185,22 @@ TBaseSymbol = class(TTypeSymbol)
function SpecializeType(const context : ISpecializationContext) : TTypeSymbol; override;
end;

TBaseIntegerSymbol = class (TBaseSymbol)
TBaseIntegerSymbol = class sealed (TBaseSymbol)
public
constructor Create;

procedure InitDataContext(const data : IDataContext; offset : NativeInt); override;
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;
Expand All @@ -1220,7 +1220,7 @@ TBaseStringSymbol = class (TBaseSymbol)
function LowPseudoSymbol(baseSymbols : TdwsBaseSymbolsContext) : TPseudoMethodSymbol; inline;
end;

TBaseBooleanSymbol = class (TBaseSymbol)
TBaseBooleanSymbol = class sealed (TBaseSymbol)
public
constructor Create;

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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;
Expand Down
77 changes: 41 additions & 36 deletions Source/dwsTokenizer.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;

Expand All @@ -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<TTokenizerConditionalInfo>;

FTokenPool : TToken;

FSourceStack : array of TTokenizerSourceInfo;
FOnEndSourceFile : TTokenizerEndSourceFileEvent;
FOnBeforeAction : TTokenizerActionEvent;

procedure AllocateToken;
procedure ReleaseToken;

Expand Down Expand Up @@ -315,6 +319,8 @@ implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------

uses dwsXPlatform, dwsStrings;

const
cFormatSettings : TFormatSettings = ( DecimalSeparator : {%H-}'.' );

Expand All @@ -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
//
Expand Down Expand Up @@ -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
//
Expand Down
4 changes: 2 additions & 2 deletions Source/dwsUtils.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down

0 comments on commit 40381b3

Please # to comment.