diff --git a/compiler/jvm/njvmadd.pas b/compiler/jvm/njvmadd.pas index 66fa870e9d..0a9ed99298 100644 --- a/compiler/jvm/njvmadd.pas +++ b/compiler/jvm/njvmadd.pas @@ -36,7 +36,6 @@ interface tjvmaddnode = class(tcgaddnode) function pass_1: tnode;override; protected - function first_addstring: tnode; override; function jvm_first_addset: tnode; function cmpnode2topcmp(unsigned: boolean): TOpCmp; @@ -99,72 +98,6 @@ interface 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; procedure call_set_helper_paras(const n : string; isenum: boolean; paras: tcallparanode); diff --git a/compiler/options.pas b/compiler/options.pas index 43dc74012d..ebb48e805e 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -2521,9 +2521,7 @@ begin {$if defined(x86) or defined(arm) or defined(jvm)} def_system_macro('INTERNAL_BACKTRACE'); {$endif} -{$ifndef jvm} def_system_macro('STR_CONCAT_PROCS'); -{$endif} {$warnings off} if pocall_default = pocall_register then def_system_macro('REGCALL'); diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 1861fe4bad..6229874c2e 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -924,6 +924,9 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} +{$push} +{$t-} + {$ifndef STR_CONCAT_PROCS} function fpc_shortstr_concat(const s1,s2:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_CONCAT']; compilerproc; @@ -1033,6 +1036,8 @@ end; {$endif STR_CONCAT_PROCS} +{$pop} + {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} diff --git a/rtl/java/compproc.inc b/rtl/java/compproc.inc index 4239d18964..5cf693935f 100644 --- a/rtl/java/compproc.inc +++ b/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_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; function fpc_shortstr_compare(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} //Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc; {$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; -//{$else STR_CONCAT_PROCS} -//{$ifndef nounsupported} +{$else STR_CONCAT_PROCS} 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_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc; Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc; -{$endif} (* {$ifdef EXTRAANSISHORT} 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 an endless loop since a 'var s: ansistring' must be made 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} {***************************************************************************** Unicode string support diff --git a/rtl/java/jastrings.inc b/rtl/java/jastrings.inc index a953c2dbc8..3f3b2681b8 100644 --- a/rtl/java/jastrings.inc +++ b/rtl/java/jastrings.inc @@ -209,7 +209,7 @@ end; {$define FPC_HAS_ANSISTR_ASSIGN} {$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 newdata: array of ansichar; thislen, addlen: sizeint; @@ -222,8 +222,8 @@ begin JLSystem.ArrayCopy(JLObject(AnsistringClass(s1).fdata),0,JLObject(newdata),0,thislen); if addlen>0 then 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; @@ -479,13 +479,13 @@ procedure FPC_ANSISTR_UNIQUE(var s: AnsiString); inline; begin s:=ansistring(AnsistringClass.Create(s)); end; - +(* Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc; begin s:=AnsistringClass.Create(ansistring(s)); result:=s; end; - +*) {$define FPC_HAS_ANSISTR_APPEND_CHAR} Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc; var diff --git a/rtl/java/justrings.inc b/rtl/java/justrings.inc index 59c5adfe22..8bd5896889 100644 --- a/rtl/java/justrings.inc +++ b/rtl/java/justrings.inc @@ -202,29 +202,29 @@ end; {$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 sb: JLStringBuilder; begin { only assign if s1 or s2 is empty } if (length(S1)=0) then begin - result:=s2; + DestS:=s2; exit; end; if (length(S2)=0) then begin - result:=s1; + DestS:=s1; exit; end; sb:=JLStringBuilder.create(S1); sb.append(s2); - result:=sb.toString; + DestS:=sb.toString; end; {$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 i : Longint; Size,NewSize : SizeInt; @@ -241,7 +241,7 @@ begin if length(sarr[i])>0 then sb.append(sarr[i]); end; - result:=sb.toString; + dests:=sb.toString; end; diff --git a/rtl/jvm/jvm.inc b/rtl/jvm/jvm.inc index ab157e147d..a580f3464a 100644 --- a/rtl/jvm/jvm.inc +++ b/rtl/jvm/jvm.inc @@ -234,99 +234,6 @@ begin 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} procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc; var