Browse Source

* use generic string concatentation and comparison infrastructure for the
JVM target (and also the generic routines in case of shortstrings)

git-svn-id: branches/jvmbackend@18910 -

Jonas Maebe 14 years ago
parent
commit
a4cf406189
7 changed files with 23 additions and 184 deletions
  1. 0 67
      compiler/jvm/njvmadd.pas
  2. 0 2
      compiler/options.pas
  3. 5 0
      rtl/inc/generic.inc
  4. 7 11
      rtl/java/compproc.inc
  5. 5 5
      rtl/java/jastrings.inc
  6. 6 6
      rtl/java/justrings.inc
  7. 0 93
      rtl/jvm/jvm.inc

+ 0 - 67
compiler/jvm/njvmadd.pas

@@ -36,7 +36,6 @@ interface
        tjvmaddnode = class(tcgaddnode)
        tjvmaddnode = class(tcgaddnode)
           function pass_1: tnode;override;
           function pass_1: tnode;override;
        protected
        protected
-          function first_addstring: tnode; override;
           function jvm_first_addset: tnode;
           function jvm_first_addset: tnode;
 
 
           function cmpnode2topcmp(unsigned: boolean): TOpCmp;
           function cmpnode2topcmp(unsigned: boolean): TOpCmp;
@@ -99,72 +98,6 @@ interface
       end;
       end;
 
 
 
 
-    function tjvmaddnode.first_addstring: tnode;
-      var
-        cmpfuncname: string;
-      begin
-        { when we get here, we are sure that both the left and the right }
-        { node are both strings of the same stringtype (JM)              }
-        case nodetype of
-          addn:
-            begin
-               if is_shortstring(resultdef) then
-                 begin
-                   result:=inherited;
-                   exit;
-                 end;
-              { unicode/ansistring operations use functions rather than
-                procedures for efficiency reasons (were also implemented before
-                var-parameters were supported; may go to procedures for
-                maintenance reasons though }
-              if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
-                begin
-                  result:=right;
-                  left.free;
-                  left:=nil;
-                  right:=nil;
-                  exit;
-                end;
-              if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
-                begin
-                  result:=left;
-                  left:=nil;
-                  right.free;
-                  right:=nil;
-                  exit;
-                end;
-
-              { create the call to the concat routine both strings as arguments }
-              result:=ccallnode.createintern('fpc_'+
-                tstringdef(resultdef).stringtypname+'_concat',
-                ccallparanode.create(right,
-                ccallparanode.create(left,nil)));
-              { we reused the arguments }
-              left := nil;
-              right := nil;
-            end;
-          ltn,lten,gtn,gten,equaln,unequaln :
-            begin
-              { call compare routine }
-              cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
-              { for equality checks use optimized version }
-              if nodetype in [equaln,unequaln] then
-                cmpfuncname := cmpfuncname + '_equal';
-
-              result := ccallnode.createintern(cmpfuncname,
-                ccallparanode.create(right,ccallparanode.create(left,nil)));
-              { and compare its result with 0 according to the original operator }
-              result := caddnode.create(nodetype,result,
-                cordconstnode.create(0,s32inttype,false));
-              left := nil;
-              right := nil;
-            end;
-          else
-            internalerror(2011031401);
-        end;
-      end;
-
-
     function tjvmaddnode.jvm_first_addset: tnode;
     function tjvmaddnode.jvm_first_addset: tnode;
 
 
       procedure call_set_helper_paras(const n : string; isenum: boolean; paras: tcallparanode);
       procedure call_set_helper_paras(const n : string; isenum: boolean; paras: tcallparanode);

+ 0 - 2
compiler/options.pas

@@ -2521,9 +2521,7 @@ begin
 {$if defined(x86) or defined(arm) or defined(jvm)}
 {$if defined(x86) or defined(arm) or defined(jvm)}
   def_system_macro('INTERNAL_BACKTRACE');
   def_system_macro('INTERNAL_BACKTRACE');
 {$endif}
 {$endif}
-{$ifndef jvm}
   def_system_macro('STR_CONCAT_PROCS');
   def_system_macro('STR_CONCAT_PROCS');
-{$endif}
 {$warnings off}
 {$warnings off}
   if pocall_default = pocall_register then
   if pocall_default = pocall_register then
     def_system_macro('REGCALL');
     def_system_macro('REGCALL');

+ 5 - 0
rtl/inc/generic.inc

@@ -924,6 +924,9 @@ end;
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
 
+{$push}
+{$t-}
+
 {$ifndef STR_CONCAT_PROCS}
 {$ifndef STR_CONCAT_PROCS}
 
 
 function fpc_shortstr_concat(const s1,s2:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_CONCAT']; compilerproc;
 function fpc_shortstr_concat(const s1,s2:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_CONCAT']; compilerproc;
@@ -1033,6 +1036,8 @@ end;
 
 
 {$endif STR_CONCAT_PROCS}
 {$endif STR_CONCAT_PROCS}
 
 
+{$pop}
+
 {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
 
 
 

+ 7 - 11
rtl/java/compproc.inc

@@ -40,7 +40,7 @@ procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
 
 
 procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
 procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
-procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
+procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of pshortstring);compilerproc;
 procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
 procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
 function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
@@ -234,20 +234,16 @@ Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
 {$ifndef nounsupported}
 {$ifndef nounsupported}
 //Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc;
 //Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc;
 {$endif}
 {$endif}
-//{$ifdef STR_CONCAT_PROCS}
-//Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
+{$ifdef STR_CONCAT_PROCS}
+Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
 Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
 Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
-//{$else STR_CONCAT_PROCS}
-//{$ifndef nounsupported}
+{$else STR_CONCAT_PROCS}
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
-//{$endif}
-//function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
-//{$endif STR_CONCAT_PROCS}
-{$ifndef nounsupported}
+function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
+{$endif STR_CONCAT_PROCS}
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc;
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc;
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); 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;
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
-{$endif}
 (*
 (*
 {$ifdef EXTRAANSISHORT}
 {$ifdef EXTRAANSISHORT}
 Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
 Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
@@ -282,7 +278,7 @@ Function  fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiSt
 { pointer argument because otherwise when calling this, we get
 { pointer argument because otherwise when calling this, we get
   an endless loop since a 'var s: ansistring' must be made
   an endless loop since a 'var s: ansistring' must be made
   unique as well                                               }
   unique as well                                               }
-Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
+//Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {*****************************************************************************
 {*****************************************************************************
                         Unicode string support
                         Unicode string support

+ 5 - 5
rtl/java/jastrings.inc

@@ -209,7 +209,7 @@ end;
 {$define FPC_HAS_ANSISTR_ASSIGN}
 {$define FPC_HAS_ANSISTR_ASSIGN}
 
 
 {$define FPC_HAS_ANSISTR_CONCAT}
 {$define FPC_HAS_ANSISTR_CONCAT}
-function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
+procedure fpc_AnsiStr_Concat (var DestS:ansistring;const S1,S2 : AnsiString); compilerproc;
 var
 var
   newdata: array of ansichar;
   newdata: array of ansichar;
   thislen, addlen: sizeint;
   thislen, addlen: sizeint;
@@ -222,8 +222,8 @@ begin
     JLSystem.ArrayCopy(JLObject(AnsistringClass(s1).fdata),0,JLObject(newdata),0,thislen);
     JLSystem.ArrayCopy(JLObject(AnsistringClass(s1).fdata),0,JLObject(newdata),0,thislen);
   if addlen>0 then
   if addlen>0 then
     JLSystem.ArrayCopy(JLObject(AnsistringClass(s2).fdata),0,JLObject(newdata),thislen,addlen);
     JLSystem.ArrayCopy(JLObject(AnsistringClass(s2).fdata),0,JLObject(newdata),thislen,addlen);
-  result:=Ansistring(AnsistringClass.Create);
-  AnsistringClass(result).fdata:=newdata;
+  dests:=Ansistring(AnsistringClass.Create);
+  AnsistringClass(dests).fdata:=newdata;
 end;
 end;
 
 
 
 
@@ -479,13 +479,13 @@ procedure FPC_ANSISTR_UNIQUE(var s: AnsiString); inline;
 begin
 begin
   s:=ansistring(AnsistringClass.Create(s));
   s:=ansistring(AnsistringClass.Create(s));
 end;
 end;
-
+(*
 Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
 Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
 begin
 begin
   s:=AnsistringClass.Create(ansistring(s));
   s:=AnsistringClass.Create(ansistring(s));
   result:=s;
   result:=s;
 end;
 end;
-
+*)
 {$define FPC_HAS_ANSISTR_APPEND_CHAR}
 {$define FPC_HAS_ANSISTR_APPEND_CHAR}
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc;
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc;
 var
 var

+ 6 - 6
rtl/java/justrings.inc

@@ -202,29 +202,29 @@ end;
 
 
 
 
 {$define FPC_HAS_UNICODESTR_CONCAT}
 {$define FPC_HAS_UNICODESTR_CONCAT}
-function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString): UnicodeString; compilerproc;
+procedure fpc_UnicodeStr_Concat (var DestS:Unicodestring;const S1,S2 : UnicodeString); compilerproc;
 Var
 Var
   sb: JLStringBuilder;
   sb: JLStringBuilder;
 begin
 begin
   { only assign if s1 or s2 is empty }
   { only assign if s1 or s2 is empty }
   if (length(S1)=0) then
   if (length(S1)=0) then
     begin
     begin
-      result:=s2;
+      DestS:=s2;
       exit;
       exit;
     end;
     end;
   if (length(S2)=0) then
   if (length(S2)=0) then
     begin
     begin
-      result:=s1;
+      DestS:=s1;
       exit;
       exit;
     end;
     end;
   sb:=JLStringBuilder.create(S1);
   sb:=JLStringBuilder.create(S1);
   sb.append(s2);
   sb.append(s2);
-  result:=sb.toString;
+  DestS:=sb.toString;
 end;
 end;
 
 
 
 
 {$define FPC_HAS_UNICODESTR_CONCAT_MULTI}
 {$define FPC_HAS_UNICODESTR_CONCAT_MULTI}
-function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
+procedure fpc_UnicodeStr_Concat_multi (var DestS:Unicodestring;const sarr:array of Unicodestring); compilerproc;
 Var
 Var
   i  : Longint;
   i  : Longint;
   Size,NewSize : SizeInt;
   Size,NewSize : SizeInt;
@@ -241,7 +241,7 @@ begin
       if length(sarr[i])>0 then
       if length(sarr[i])>0 then
         sb.append(sarr[i]);
         sb.append(sarr[i]);
     end;
     end;
-  result:=sb.toString;
+  dests:=sb.toString;
 end;
 end;
 
 
 
 

+ 0 - 93
rtl/jvm/jvm.inc

@@ -234,99 +234,6 @@ begin
 end;
 end;
 
 
 
 
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
-var
-  tmpres: ShortstringClass;
-  s1l, s2l: longint;
-begin
-  s1l:=length(s1);
-  s2l:=length(s2);
-  if (s1l+s2l)>high(dests) then
-    begin
-      if s1l>high(dests) then
-        s1l:=high(dests);
-      s2l:=high(dests)-s1l;
-    end;
-  if ShortstringClass(@dests)=ShortstringClass(@s1) then
-    JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
-  else if ShortstringClass(@dests)=ShortstringClass(@s2) then
-    begin
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(@dests).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l);
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
-    end
-  else
-    begin
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
-    end;
-  ShortstringClass(@dests).curlen:=s1l+s2l;
-end;
-
-
-procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
-var
-  s2l : byte;
-  LowStart,i,
-  Len : longint;
-  needtemp : boolean;
-  tmpstr  : shortstring;
-  p,pdest  : ShortstringClass;
-begin
-  if high(sarr)=0 then
-    begin
-      DestS:='';
-      exit;
-    end;
-  lowstart:=low(sarr);
-  if ShortstringClass(@DestS)=sarr[lowstart] then
-    inc(lowstart);
-  { Check for another reuse, then we can't use
-    the append optimization and need to use a temp }
-  needtemp:=false;
-  for i:=lowstart to high(sarr) do
-    begin
-      if ShortstringClass(@DestS)=sarr[i] then
-        begin
-          needtemp:=true;
-          break;
-        end;
-    end;
-  if needtemp then
-    begin
-      lowstart:=low(sarr);
-      tmpstr:='';
-      pdest:=ShortstringClass(@tmpstr)
-    end
-  else
-    begin
-      { Start with empty DestS if we start with concatting
-        the first array element }
-      if lowstart=low(sarr) then
-        DestS:='';
-      pdest:=ShortstringClass(@DestS);
-    end;
-  { Concat all strings, except the string we already
-    copied in DestS }
-  Len:=pdest.curlen;
-  for i:=lowstart to high(sarr) do
-    begin
-      p:=sarr[i];
-      if assigned(p) then
-        begin
-          s2l:=p.curlen;
-          if Len+s2l>high(dests) then
-            s2l:=high(dests)-Len;
-          JLSystem.ArrayCopy(JLObject(p.fdata),0,JLObject(pdest.fdata),len,s2l);
-          inc(Len,s2l);
-        end;
-    end;
-  pdest.curlen:=len;
-  if needtemp then
-    DestS:=TmpStr;
-end;
-
-
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
 procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
 procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
 var
 var