From 9d969a5fb1d8f9b938d45a5e5d929b76b7d30930 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 31 Aug 2019 10:38:49 +0000 Subject: [PATCH] * Speed improvements, iteration 1 git-svn-id: trunk@42882 - --- packages/fcl-json/src/fpjson.pp | 58 ++++++++++++++---- packages/fcl-json/src/jsonparser.pp | 24 ++++++++ packages/fcl-json/src/jsonreader.pp | 8 +-- packages/fcl-json/src/jsonscanner.pp | 89 +++++++++++++++------------- 4 files changed, 122 insertions(+), 57 deletions(-) diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp index 824e3af0df..e4a8bab398 100644 --- a/packages/fcl-json/src/fpjson.pp +++ b/packages/fcl-json/src/fpjson.pp @@ -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 diff --git a/packages/fcl-json/src/jsonparser.pp b/packages/fcl-json/src/jsonparser.pp index 0b02e632cf..41ca48d11a 100644 --- a/packages/fcl-json/src/jsonparser.pp +++ b/packages/fcl-json/src/jsonparser.pp @@ -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 diff --git a/packages/fcl-json/src/jsonreader.pp b/packages/fcl-json/src/jsonreader.pp index ce4fbee468..d3180b1517 100644 --- a/packages/fcl-json/src/jsonreader.pp +++ b/packages/fcl-json/src/jsonreader.pp @@ -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; diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp index aa0701b53d..ad949b408c 100644 --- a/packages/fcl-json/src/jsonscanner.pp +++ b/packages/fcl-json/src/jsonscanner.pp @@ -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:=FCurRowNil) 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