* Speed improvements, iteration 1

git-svn-id: trunk@42882 -

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);
+  if Assigned(JPSH) then
-  try
+    JPSH(JSON,useUTF8,Result)
-    Result:=GetJSON(SS,UseUTF8);
+  else
-  finally
+    begin
-    SS.Free;
+    if UseUTF8 then
-  end;
+      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
+  If (JPH<>Nil) then
-    TJSONData.DoError(SErrNoParserHandler);
+    JPH(JSON,UseUTF8,Result)
-  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

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

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;

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;
+    procedure Error(const Msg: string;  Const Args: array of const);overload;
-      Const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});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 aSource : RawByteString; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';
-    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
+    constructor Create(const aSource: RawByteString; AOptions: TJSONOptions); overload;
-    destructor Destroy; override;
     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:=aSource;
-  FSource.LoadFromStream(Source);
+  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;
+procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
-  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 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:=FCurPos;
-      FTokenStr:=PChar(FCurLine);
+      While Not (FCurPos^ in [#0,#10,#13]) do
-      Inc(FCurRow);
+        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