paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 06:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use generic string concatentation and comparison infrastructure for the

Browse Source 
JVM target (and also the generic routines in case of shortstrings)

git-svn-id: branches/jvmbackend@18910 -
This commit is contained in:
Jonas Maebe 2011-08-29 22:59:25 +00:00
parent 1fbd8750f2
commit a4cf406189
7 changed files with 23 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
compiler/jvm/njvmadd.pas
View File

@ -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);

2
compiler/options.pas
View File

@ -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');

5
rtl/inc/generic.inc
View File

@ -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}

18
rtl/java/compproc.inc
View File

@ -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

10
rtl/java/jastrings.inc
View File

@ -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

12
rtl/java/justrings.inc
View File

@ -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;

93
rtl/jvm/jvm.inc
View File

@ -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