* optimize multiple concats for ansi/widestring

git-svn-id: trunk@2650 -

compiler/nadd.pas

@@ -1920,6 +1920,16 @@ implementation
          rd,ld   : tdef;
       begin
          result:=nil;
+
+         { Can we optimize multiple string additions into a single call?
+           This need to be done on a complete tree to detect the multiple
+           add nodes and is therefor done before the subtrees are processed }
+         if canbemultistringadd(self) then
+           begin
+             result := genmultistringadd(self);
+             exit;
+           end;
+
          { first do the two subtrees }
          firstpass(left);
          firstpass(right);

compiler/nopt.pas

@@ -74,6 +74,8 @@ function canbeaddsstringcharoptnode(p: taddnode): boolean;
 function genaddsstringcharoptnode(p: taddnode): tnode;
 function canbeaddsstringcsstringoptnode(p: taddnode): boolean;
 function genaddsstringcsstringoptnode(p: taddnode): tnode;
+function canbemultistringadd(p: taddnode): boolean;
+function genmultistringadd(p: taddnode): tnode;
 
 
 function is_addsstringoptnode(p: tnode): boolean;
@@ -84,7 +86,7 @@ var
 
 implementation
 
-uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,ncal,
+uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,ncal,nld,
      verbose, symconst,symdef, cgbase, procinfo;
 
 
@@ -282,6 +284,45 @@ begin
 end;
 
 
+function canbemultistringadd(p: taddnode): boolean;
+var
+  hp : tnode;
+  i  : longint;
+begin
+  i:=0;
+  if is_ansistring(p.resulttype.def) or
+     is_widestring(p.resulttype.def) then
+    begin
+      hp:=p;
+      while assigned(hp) and (hp.nodetype=addn) do
+        begin
+          inc(i);
+          hp:=taddnode(hp).left;
+        end;
+    end;
+  result:=(i>1);
+end;
+
+
+function genmultistringadd(p: taddnode): tnode;
+var
+  hp : tnode;
+  arrp  : tarrayconstructornode;
+begin
+  arrp:=nil;
+  hp:=p;
+  while assigned(hp) and (hp.nodetype=addn) do
+    begin
+      arrp:=carrayconstructornode.create(taddnode(hp).right.getcopy,arrp);
+      hp:=taddnode(hp).left;
+    end;
+  arrp:=carrayconstructornode.create(hp.getcopy,arrp);
+  result := ccallnode.createintern('fpc_'+
+    tstringdef(p.resulttype.def).stringtypname+'_concat_multi',
+    ccallparanode.create(arrp,nil));
+end;
+
+
 begin
   caddsstringcharoptnode := taddsstringcharoptnode;
   caddsstringcsstringoptnode := taddsstringcsstringoptnode;

rtl/inc/astrings.inc

@@ -143,30 +143,51 @@ end;
 Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_ANSISTR_ASSIGN'];
 
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
-var
-  S3: ansistring absolute result;
-{
-  Concatenates 2 AnsiStrings : S1+S2.
-  Result Goes to S3;
-}
 Var
   Size,Location : SizeInt;
+  pc : pchar;
 begin
   { only assign if s1 or s2 is empty }
   if (S1='') then
-    s3 := s2
-  else if (S2='') then
-    s3 := s1
-  else
     begin
-       Size:=length(S2);
+      result:=s2;
-       Location:=Length(S1);
+      exit;
-       SetLength (S3,Size+Location);
+    end;
-       { the cast to a pointer avoids the unique call }
+  if (S2='') then
-       { and we don't need an unique call             }
+    begin
-       { because of the SetLength S3 is unique        }
+      result:=s1;
-       Move (S1[1],pointer(S3)^,Location);
+      exit;
-       Move (S2[1],pointer(pointer(S3)+location)^,Size+1);
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  SetLength(result,Size+Location);
+  pc:=pchar(result);
+  Move(S1[1],pc^,Location);
+  inc(pc,location);
+  Move(S2[1],pc^,Size+1);
+end;
+
+
+function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
+Var
+  i  : Longint;
+  p  : pointer;
+  pc : pchar;
+  Size,NewSize : SizeInt;
+begin
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  SetLength(result,NewSize);
+  pc:=pchar(result);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      Size:=length(ansistring(p));
+      Move(pchar(p)^,pc^,Size+1);
+      inc(pc,size);
     end;
 end;
 

rtl/inc/compproc.inc

@@ -109,6 +109,7 @@ Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
 Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
 Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
+function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : char); compilerproc;
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
@@ -141,6 +142,7 @@ Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerpro
 Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
 Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
 Function fpc_WideStr_Concat (const S1,S2 : WideString) : WideString; compilerproc;
+function fpc_WideStr_Concat_multi (const sarr:array of Widestring): widestring; compilerproc;
 Function fpc_Char_To_WideStr(const c : WideChar): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;

rtl/inc/wstrings.inc

@@ -382,31 +382,52 @@ end;
 { alias for internal use }
 Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
 
-{ checked against the ansistring routine, 2001-05-27 (FK) }
 function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
-var
-  S3: WideString absolute result;
-{
-  Concatenates 2 WideStrings : S1+S2.
-  Result Goes to S3;
-}
 Var
   Size,Location : SizeInt;
+  pc : pwidechar;
 begin
-{ only assign if s1 or s2 is empty }
+  { only assign if s1 or s2 is empty }
   if (S1='') then
-    S3 := S2
-  else
-    if (S2='') then
-      S3 := S1
-  else
     begin
-       { create new result }
+      result:=s2;
-       Size:=Length(S2);
+      exit;
-       Location:=Length(S1);
+    end;
-       SetLength (S3,Size+Location);
+  if (S2='') then
-       Move (S1[1],S3[1],Location*sizeof(WideChar));
+    begin
-       Move (S2[1],S3[location+1],(Size+1)*sizeof(WideChar));
+      result:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  SetLength(result,Size+Location);
+  pc:=pwidechar(result);
+  Move(S1[1],pc^,Location*sizeof(WideChar));
+  inc(pc,location);
+  Move(S2[1],pc^,(Size+1)*sizeof(WideChar));
+end;
+
+
+function fpc_WideStr_Concat_multi (const sarr:array of Widestring): widestring; compilerproc;
+Var
+  i  : Longint;
+  p  : pointer;
+  pc : pwidechar;
+  Size,NewSize : SizeInt;
+begin
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  SetLength(result,NewSize);
+  pc:=pwidechar(result);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      Size:=length(widestring(p));
+      Move(pwidechar(p)^,pc^,(Size+1)*sizeof(WideChar));
+      inc(pc,size);
     end;
 end;
 
@@ -450,7 +471,7 @@ begin
       i:=IndexChar(arr,high(arr)+1,#0);
       if i = -1 then
         i := high(arr)+1;
-    end 
+    end
   else
     i := high(arr)+1;
   SetLength(fpc_CharArray_To_WideStr,i);
@@ -493,7 +514,7 @@ begin
       i:=IndexWord(arr,high(arr)+1,0);
       if i = -1 then
         i := high(arr)+1;
-    end 
+    end
   else
     i := high(arr)+1;
   SetLength(fpc_WideCharArray_To_AnsiStr,i);
@@ -509,7 +530,7 @@ begin
       i:=IndexWord(arr,high(arr)+1,0);
       if i = -1 then
         i := high(arr)+1;
-    end 
+    end
   else
     i := high(arr)+1;
   SetLength(fpc_WideCharArray_To_WideStr,i);