paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 18:10:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Speed improvements, iteration 1

Browse Source 
git-svn-id: trunk@42882 -
This commit is contained in:
michael 2019-08-31 10:38:49 +00:00
parent 869fc5c7b3
commit 9d969a5fb1
4 changed files with 122 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
packages/fcl-json/src/fpjson.pp
View File

@ -723,6 +723,7 @@ Type
{$ifdef fpc}
TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
TJSONStringParserHandler = Procedure(Const aJSON : TJSONStringType; Const AUseUTF8 : Boolean; Out Data : TJSONData);
{$endif}
Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
@ -754,7 +755,9 @@ Function CreateJSONObject(const Data : Array of {$ifdef pas2js}jsvalue{$else}Con
Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
Function GetJSONParserHandler : TJSONParserHandler;
Function GetJSONStringParserHandler: TJSONStringParserHandler;
{$endif}
implementation
@ -1003,31 +1006,57 @@ begin
end;
{$ifdef fpc}
Var
JPH : TJSONParserHandler;
JPSH : TJSONStringParserHandler;
function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
Var
SS : TStringStream;
begin
SS:=TStringStream.Create(JSON);
try
Result:=GetJSON(SS,UseUTF8);
finally
SS.Free;
end;
if Assigned(JPSH) then
JPSH(JSON,useUTF8,Result)
else
begin
if UseUTF8 then
SS:=TStringStream.Create(JSON,TEncoding.UTF8)
else
SS:=TStringStream.Create(JSON);
try
Result:=GetJSON(SS,UseUTF8);
finally
SS.Free;
end;
end;
end;
{$endif}
{$ifdef fpc}
Var
JPH : TJSONParserHandler;
function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
Var
S : TJSONStringType;
begin
Result:=Nil;
If (JPH=Nil) then
TJSONData.DoError(SErrNoParserHandler);
JPH(JSON,UseUTF8,Result);
If (JPH<>Nil) then
JPH(JSON,UseUTF8,Result)
else if JPSH=Nil then
TJSONData.DoError(SErrNoParserHandler)
else
begin
Setlength(S,JSON.Size);
if Length(S)>0 then
JSON.ReadBuffer(S[1],Length(S));
end;
end;
Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
begin
Result:=JPSH;
JPSH:=AHandler;
end;
function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
@ -1040,6 +1069,11 @@ function GetJSONParserHandler: TJSONParserHandler;
begin
Result:=JPH;
end;
function GetJSONStringParserHandler: TJSONStringParserHandler;
begin
Result:=JPSH;
end;
{$endif}
Type

24
packages/fcl-json/src/jsonparser.pp
View File

@ -82,6 +82,26 @@ begin
end;
end;
procedure DefJSONStringParserHandler(Const S : TJSONStringType; const AUseUTF8: Boolean; out
Data: TJSONData);
Var
P : TJSONParser;
AOptions: TJSONOptions;
begin
Data:=Nil;
AOptions:=[];
if AUseUTF8 then
Include(AOptions,joUTF8);
P:=TJSONParser.Create(S,AOptions);
try
Data:=P.Parse;
finally
P.Free;
end;
end;
procedure TJSONParser.Pop(aType: TJSONType);
begin
@ -224,6 +244,8 @@ Procedure InitJSONHandler;
begin
if GetJSONParserHandler=Nil then
SetJSONParserHandler(@DefJSONParserHandler);
if GetJSONStringParserHandler=Nil then
SetJSONStringParserHandler(@DefJSONStringParserHandler);
end;
Procedure DoneJSONHandler;
@ -231,6 +253,8 @@ Procedure DoneJSONHandler;
begin
if GetJSONParserHandler=@DefJSONParserHandler then
SetJSONParserHandler(Nil);
if GetJSONStringParserHandler=@DefJSONStringParserHandler then
SetJSONStringParserHandler(Nil);
end;
initialization

8
packages/fcl-json/src/jsonreader.pp
View File

@ -60,9 +60,9 @@ Type
Property Scanner : TJSONScanner read FScanner;
Public
Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
Constructor Create(Const Source : RawByteString; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
constructor Create(const Source: RawByteString; AOptions: TJSONOptions); overload;
destructor Destroy();override;
// Parsing options
Property Options : TJSONOptions Read GetOptions Write SetOptions;
@ -415,7 +415,7 @@ begin
Options:=Options + [joUTF8];
end;
constructor TBaseJSONReader.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
constructor TBaseJSONReader.Create(const Source: RawByteString; AUseUTF8 : Boolean = True);
begin
Inherited Create;
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
@ -428,7 +428,7 @@ begin
FScanner:=TJSONScanner.Create(Source,AOptions);
end;
constructor TBaseJSONReader.Create(const Source: String; AOptions: TJSONOptions);
constructor TBaseJSONReader.Create(const Source: RawByteString; AOptions: TJSONOptions);
begin
FScanner:=TJSONScanner.Create(Source,AOptions);
end;

89
packages/fcl-json/src/jsonscanner.pp
View File

@ -15,10 +15,6 @@
{$mode objfpc}
{$h+}
{$ifdef fpc}
{$define UsePChar}
{$endif}
unit jsonscanner;
interface
@ -66,29 +62,26 @@ Type
TJSONScanner = class
private
FSource: TStringList;
FSource: RawByteString;
FCurPos : PAnsiChar; // Position inside total string
FCurRow: Integer;
FCurToken: TJSONToken;
FCurTokenString: string;
FCurLine: string;
FTokenStr: {$ifdef UsePChar}PChar{$else}integer{$endif}; // position inside FCurLine
FTokenStr: PAnsiChar; // position inside FCurLine
FOptions : TJSONOptions;
function GetCurColumn: Integer; inline;
function GetO(AIndex: TJSONOption): Boolean;
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
protected
procedure Error(const Msg: string);overload;
procedure Error(const Msg: string;
Const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});overload;
procedure Error(const Msg: string; Const Args: array of const);overload;
function DoFetchToken: TJSONToken; inline;
public
{$ifdef fpc}
constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
{$endif}
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
destructor Destroy; override;
constructor Create(const aSource : RawByteString; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
constructor Create(const aSource: RawByteString; AOptions: TJSONOptions); overload;
function FetchToken: TJSONToken;
@ -129,7 +122,6 @@ const
implementation
{$ifdef fpc}
constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
Var
@ -144,7 +136,20 @@ begin
Create(Source,O);
end;
constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
Var
S : RawByteString;
begin
S:='';
SetLength(S,Source.Size);
if Length(S)>0 then
Source.ReadBuffer(S[1],Length(S));
Create(S,AOptions)
end;
constructor TJSONScanner.Create(const aSource : RawByteString; AUseUTF8 : Boolean = True);
Var
O : TJSONOptions;
@ -154,30 +159,15 @@ begin
Include(O,joUTF8)
else
Exclude(O,joUTF8);
Create(Source,O);
Create(aSource,O);
end;
constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
constructor TJSONScanner.Create(const aSource: RawByteString; AOptions: TJSONOptions);
begin
FSource:=TStringList.Create;
FSource.LoadFromStream(Source);
FSource:=aSource;
FCurPos:=PAnsiChar(FSource);
FOptions:=AOptions;
end;
{$endif}
constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
begin
FSource:=TStringList.Create;
FSource.Text:=Source;
FOptions:=AOptions;
end;
destructor TJSONScanner.Destroy;
begin
FreeAndNil(FSource);
Inherited;
end;
function TJSONScanner.FetchToken: TJSONToken;
@ -190,8 +180,7 @@ begin
raise EScannerError.Create(Msg);
end;
procedure TJSONScanner.Error(const Msg: string;
const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
begin
raise EScannerError.CreateFmt(Msg, Args);
end;
@ -199,13 +188,31 @@ end;
function TJSONScanner.DoFetchToken: TJSONToken;
function FetchLine: Boolean;
var
PEOL : PAnsiChar;
Len : integer;
begin
Result:=FCurRow<FSource.Count;
Result:=(FCurPos<>Nil) and (FCurPos^<>#0);
if Result then
begin
FCurLine:=FSource[FCurRow];
FTokenStr:=PChar(FCurLine);
Inc(FCurRow);
FTokenStr:=FCurPos;
While Not (FCurPos^ in [#0,#10,#13]) do
Inc(FCurPos);
PEOL:=FCurPos;
if (FCurPos^<>#0) then
begin
if (FCurPos^=#13) and (FCurPos[1]=#10) then
Inc(FCurPos); // Skip CR-LF
Inc(FCurPos); // To start of next line
Inc(FCurRow); // Increase line index
end;
Len:=PEOL-FTokenStr;
SetLength(FCurLine,Len);
if Len>0 then
Move(FTokenStr^,FCurLine[1],Len);
FTokenStr:=PAnsiChar(FCurLine);
end
else
begin
@ -226,7 +233,7 @@ var
Procedure MaybeAppendUnicode;
Var
u : String;
u : UTF8String;
begin
// if there is a leftover \u, append