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

+ support for pointers to types that are implicit pointer types in the JVM

Browse Source 
(non-dynamic arrays, records, shortstrings)
  - removed the ability to typecast such types directly into related class
    types, you have to use the @-operator first now to get a pointer to
    the type
   o updated the RTL and internal compiler code to properly use this
     new convention
   o allowed removing several special cases from
     tjvmtypeconvnode.target_specific_general_typeconv(), and that
     method can probably be removed completely over time
  * no longer give compile time errors for pointer-related typecasts that
    will fail at run time, because the checking was too complex and could
    be worked around via actual pointer typecasts anyway
  * removed some unnecessary checkcast operations (for shortstring/
    shortstringclass)

git-svn-id: branches/jvmbackend@18574 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:11:49 +00:00
parent 207a4a32d3
commit 0706cb5eb6
12 changed files with 244 additions and 292 deletions

318
compiler/jvm/njvmcnv.pas
View File

@ -112,7 +112,9 @@ implementation
if def1.typ<>procvardef then
exit;
if tprocvardef(def1).is_addressonly then
result:=def2=java_jlobject
result:=
(def2=java_jlobject) or
(def2=voidpointertype)
else
begin
if not assigned(tmethoddef) then
@ -533,6 +535,81 @@ implementation
left:=nil;
end;
function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
function check_type_equality(def1,def2: tdef): boolean;
begin
result:=true;
if is_ansistring(def1) and
(def2=java_ansistring) then
exit;
if is_wide_or_unicode_string(def1) and
(def2=java_jlstring) then
exit;
if def1.typ=pointerdef then
begin
if is_shortstring(tpointerdef(def1).pointeddef) and
(def2=java_shortstring) then
exit;
end;
result:=false;
end;
function check_array_type_equality(def1,def2: tdef): boolean;
begin
result:=true;
if is_shortstring(def1) and
(def2=java_shortstring) then
exit;
result:=false;
end;
begin
result:=true;
if (todef=java_jlobject) or
(todef=voidpointertype) then
exit;
if compare_defs(fromdef,todef,nothingn)>=te_equal then
exit;
{ trecorddef.is_related() must work for inheritance/method checking,
but do not allow records to be directly typecasted into class/
pointer types (you have to use FpcBaseRecordType(@rec) instead) }
if not is_record(fromdef) and
fromdef.is_related(todef) then
exit;
if check_type_equality(fromdef,todef) then
exit;
if check_type_equality(todef,fromdef) then
exit;
if (fromdef.typ=pointerdef) and
(tpointerdef(fromdef).pointeddef.typ=recorddef) and
(todef=java_fpcbaserecordtype) then
exit;
{ all classrefs are currently java.lang.Class at the bytecode level }
if (fromdef.typ=classrefdef) and
(todef.typ=objectdef) and
(todef=search_system_type('JLCLASS').typedef) then
exit;
if (fromdef.typ=classrefdef) and
(todef.typ=classrefdef) and
tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef) then
exit;
{ special case: "array of shortstring" to "array of ShortstringClass"
and "array of <record>" to "array of FpcRecordBaseType" (normally
you have to use ShortstringClass(@shortstrvar) etc, but that's not
possible in case of passing arrays to e.g. setlength) }
if is_dynamic_array(left.resultdef) and
is_dynamic_array(resultdef) then
begin
if check_array_type_equality(fromdef,todef) or
check_array_type_equality(todef,fromdef) then
exit;
if is_record(fromdef) and
(todef=java_fpcbaserecordtype) then
exit;
end;
result:=false;
end;
var
fromclasscompatible,
@ -553,16 +630,18 @@ implementation
types }
procvarconv:=isvalidprocvartypeconv(left.resultdef,resultdef);
fromclasscompatible:=
(left.resultdef.typ=pointerdef) or
(left.resultdef.typ=objectdef) or
is_dynamic_array(left.resultdef) or
((left.resultdef.typ in [recorddef,stringdef,classrefdef]) and
(resultdef.typ=objectdef)) or
((left.resultdef.typ in [stringdef,classrefdef]) and
not is_shortstring(left.resultdef)) or
procvarconv;
toclasscompatible:=
(resultdef.typ=pointerdef) or
(resultdef.typ=objectdef) or
is_dynamic_array(resultdef) or
((resultdef.typ in [recorddef,stringdef,classrefdef]) and
(left.resultdef.typ=objectdef)) or
((resultdef.typ in [stringdef,classrefdef]) and
not is_shortstring(resultdef)) or
procvarconv;
if fromclasscompatible and toclasscompatible then
begin
@ -582,32 +661,28 @@ implementation
get_most_nested_types(fromdef,todef);
fromarrtype:=jvmarrtype_setlength(fromdef);
toarrtype:=jvmarrtype_setlength(todef);
if (compare_defs(fromdef,todef,nothingn)<te_equal) and
not fromdef.is_related(todef) and
(todef<>java_jlobject) and
((fromarrtype in ['A','R']) or
(fromarrtype<>toarrtype)) and
((fromdef.typ<>classrefdef) or
(todef.typ<>classrefdef) or
not tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef)) then
if not ptr_no_typecheck_required(fromdef,todef) then
begin
if not check_only and
not assignment_side then
if (fromarrtype in ['A','R','T']) or
(fromarrtype<>toarrtype) then
begin
resnode:=ctypenode.create(resultdef);
if resultdef.typ=objectdef then
resnode:=cloadvmtaddrnode.create(resnode);
resnode:=casnode.create(left,resnode);
if resultdef.typ=classrefdef then
tjvmasnode(resnode).classreftypecast:=true;
left:=nil;
if not check_only and
not assignment_side then
begin
resnode:=ctypenode.create(resultdef);
if resultdef.typ=objectdef then
resnode:=cloadvmtaddrnode.create(resnode);
resnode:=casnode.create_internal(left,resnode);
if resultdef.typ=classrefdef then
tjvmasnode(resnode).classreftypecast:=true;
left:=nil;
end
end
end
{ typecasting from a child to a parent type on the assignment side
will (rightly) mess up the type safety verification of the JVM }
else if assignment_side and
(compare_defs(fromdef,todef,nothingn)<te_equal) then
CGMessage(type_e_no_managed_assign_generic_typecast);
{ typecasting from a child to a parent type on the assignment side
will (rightly) mess up the type safety verification of the JVM }
else if assignment_side then
CGMessage(type_e_no_managed_assign_generic_typecast);
end;
result:=true;
exit;
end;
@ -702,36 +777,6 @@ implementation
function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
begin
result:=false;
{ deal with explicit typecasts between records and classes (for
FpcBaseRecordType) }
if ((left.resultdef.typ=recorddef) and
(resultdef.typ=objectdef) and
left.resultdef.is_related(resultdef)) or
((left.resultdef.typ=objectdef) and
(resultdef.typ=recorddef) and
resultdef.is_related(left.resultdef)) and
(nf_explicit in flags) then
begin
convtype:=tc_equal;
result:=true;
exit;
end;
{ deal with explicit typecasts between shortstrings and classes (for
ShortstringClass) }
if (is_shortstring(left.resultdef) and
(resultdef.typ=objectdef) and
left.resultdef.is_related(resultdef)) or
((left.resultdef.typ=objectdef) and
is_shortstring(resultdef) and
resultdef.is_related(left.resultdef)) and
(nf_explicit in flags) then
begin
convtype:=tc_equal;
result:=true;
exit;
end;
{$ifndef nounsupported}
{ generated in nmem; replace voidpointertype with java_jlobject }
if nf_load_procvar in flags then
@ -754,169 +799,24 @@ implementation
*****************************************************************************}
function asis_target_specific_typecheck(node: tasisnode): boolean;
function isrecordconv(fromdef, todef: tdef): boolean;
begin
if isvalidprocvartypeconv(fromdef,todef) then
begin
result:=true;
exit;
end;
if is_record(todef) then
begin
result:=
(fromdef=java_jlobject) or
(fromdef=java_fpcbaserecordtype);
end
else if is_record(fromdef) then
begin
result:=
(todef=java_jlobject) or
(todef=java_fpcbaserecordtype)
end
else
result:=false;
end;
function isstringconv(fromdef, todef: tdef): boolean;
function unicodestrcompatible(def: tdef): boolean;
begin
result:=
(def=java_jlobject) or
(def=java_jlstring);
end;
function ansistrcompatible(def: tdef): boolean;
begin
result:=
(def=java_jlobject) or
(def=java_ansistring);
end;
function shortstrcompatible(def: tdef): boolean;
begin
result:=
(def=java_jlobject) or
(def=java_shortstring);
end;
begin
if is_wide_or_unicode_string(todef) then
begin
result:=unicodestrcompatible(fromdef)
end
else if is_wide_or_unicode_string(fromdef) then
begin
result:=unicodestrcompatible(todef);
end
else if is_ansistring(todef) then
begin
result:=ansistrcompatible(fromdef);
end
else if is_ansistring(fromdef) then
begin
result:=ansistrcompatible(todef);
end
else if is_shortstring(todef) then
begin
result:=shortstrcompatible(fromdef)
end
else if is_shortstring(fromdef) then
begin
result:=shortstrcompatible(todef)
end
else
result:=false;
end;
function isclassrefconv(fromdef, todef: tdef): boolean;
var
jlclass: tdef;
begin
jlclass:=nil;
if fromdef.typ=classrefdef then
begin
result:=todef=java_jlobject;
if not result and
(todef.typ=classrefdef) then
{ the fromdef.is_related(todef) case should not become an as-node,
handled in typeconversion itself and ignored since always ok
-- this one is not very useful either since everything is plain
JLClass anyway, but maybe in the future it will be different }
result:=tclassrefdef(todef).pointeddef.is_related(tclassrefdef(fromdef).pointeddef);
if not result then
begin
jlclass:=search_system_type('JLCLASS').typedef;
result:=todef=jlclass;
end;
end
else if todef.typ=classrefdef then
begin
result:=fromdef=java_jlobject;
if not result then
begin
jlclass:=search_system_type('JLCLASS').typedef;
result:=fromdef=jlclass;
end;
end
else
result:=false;
end;
var
fromelt, toelt: tdef;
realfromdef,
realtodef: tdef;
begin
if is_java_class_or_interface(node.left.resultdef) and
(node.right.resultdef.typ=classrefdef) and
((node.nodetype<>asn) or
not tjvmasnode(node).classreftypecast) then
if not(nf_internal in node.flags) then
begin
{ handle using normal code }
result:=false;
exit;
end;
realfromdef:=maybe_find_real_class_definition(node.left.resultdef,false);
result:=true;
{ these are converted type conversion nodes, to insert the checkcast
operations }
realtodef:=node.right.resultdef;
if (realtodef.typ=classrefdef) and
((node.nodetype<>asn) or
not tjvmasnode(node).classreftypecast) then
realtodef:=tclassrefdef(realtodef).pointeddef;
realtodef:=maybe_find_real_class_definition(realtodef,false);
result:=isrecordconv(realfromdef,realtodef);
if not result then
result:=isstringconv(realfromdef,realtodef);
if not result then
result:=isclassrefconv(realfromdef,realtodef);
if not result then
{ dynamic arrays can be converted to java.lang.Object and vice versa }
if realtodef=java_jlobject then
{ dynamic array to java.lang.Object }
result:=is_dynamic_array(realfromdef)
else if is_dynamic_array(realtodef) then
begin
{ <x> to dynamic array: only if possibly valid }
fromelt:=node.left.resultdef;
toelt:=realtodef;
get_most_nested_types(fromelt,toelt);
{ final levels must be convertable:
a) from array (dynamic or not) to java.lang.Object or vice versa,
or
b) the same primitive/class type
}
result:=
isrecordconv(fromelt,toelt) or
isstringconv(fromelt,toelt) or
(compare_defs(fromelt,toelt,node.left.nodetype) in [te_exact,te_equal]) or
(((fromelt.typ=objectdef) or
(fromelt.typ=arraydef)) and
((toelt.typ=objectdef) or
(toelt.typ=arraydef)));
end;
if result then
if node.nodetype=asn then
node.resultdef:=realtodef
@ -995,6 +895,10 @@ implementation
else
checkdef:=node.right.resultdef;
{ replace special types with their equivalent class type }
if checkdef=voidpointertype then
checkdef:=java_jlobject
else if checkdef.typ=pointerdef then
checkdef:=tpointerdef(checkdef).pointeddef;
{$ifndef nounsupported}
if checkdef.typ=procvardef then
checkdef:=java_jlobject

4
compiler/jvm/njvminl.pas
View File

@ -87,7 +87,7 @@ implementation
aasmbase,aasmtai,aasmdata,aasmcpu,
symtype,symconst,symdef,symsym,symtable,jvmdef,
defutil,
nbas,ncon,ncnv,ncal,nld,nflw,nutils,
nbas,ncon,ncnv,nmem,ncal,nld,nflw,nutils,
cgbase,pass_1,pass_2,
cpuinfo,ncgutil,
cgutils,hlcgobj,hlcgcpu;
@ -577,7 +577,7 @@ implementation
internalerror(2011052402);
result:=
ccallnode.create(nil,tprocsym(psym),psym.owner,
ctypeconvnode.create_explicit(left,java_shortstring),[]);
ctypeconvnode.create_explicit(caddrnode.create_internal(left),java_shortstring),[]);
{ reused }
left:=nil;
end

3
compiler/jvm/njvmld.pas
View File

@ -93,7 +93,8 @@ function tjvmassignmentnode.pass_1: tnode;
byte(str[x]):=12;
}
inserttypeconv_explicit(right,cchartype);
{ call ShortstringClass(shortstring).setChar(index,char) }
{ call ShortstringClass(@shortstring).setChar(index,char) }
tvecnode(target).left:=caddrnode.create_internal(tvecnode(target).left);
inserttypeconv_explicit(tvecnode(target).left,java_shortstring);
psym:=search_struct_member(tabstractrecorddef(java_shortstring),'SETCHAR');
if not assigned(psym) or

69
compiler/jvm/njvmmem.pas
View File

@ -36,6 +36,11 @@ interface
procedure pass_generate_code; override;
end;
tjvmderefnode = class(tcgderefnode)
function pass_typecheck:tnode;override;
procedure pass_generate_code; override;
end;
tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode)
procedure pass_generate_code; override;
end;
@ -60,6 +65,35 @@ implementation
aasmdata,aasmcpu,pass_2,
cgutils,hlcgobj,hlcgcpu;
{*****************************************************************************
TJVMDEREFNODE
*****************************************************************************}
function tjvmderefnode.pass_typecheck: tnode;
begin
result:=inherited;
if not(left.resultdef.typ=pointerdef) or
not jvmimplicitpointertype(tpointerdef(left.resultdef).pointeddef) then
begin
CGMessage(parser_e_illegal_expression);
exit
end;
end;
procedure tjvmderefnode.pass_generate_code;
begin
secondpass(left);
if (left.resultdef.typ=pointerdef) or
jvmimplicitpointertype(left.resultdef) then
begin
{ this is basically a typecast: the left node is a regular
'pointer', and we typecast it to an implicit pointer }
location_copy(location,left.location);
end
else
internalerror(2011052901);
end;
{*****************************************************************************
TJVMADDRNODE
*****************************************************************************}
@ -82,26 +116,15 @@ implementation
begin
result:=inherited;
exit;
end;
if not jvmimplicitpointertype(left.resultdef) then
end
else
begin
CGMessage(parser_e_illegal_expression);
exit
end;
resultdef:=java_jlobject;
if mark_read_written then
begin
{ This is actually only "read", but treat it nevertheless as }
{ modified due to the possible use of pointers }
{ To avoid false positives regarding "uninitialised" }
{ warnings when using arrays, perform it in two steps }
set_varstate(left,vs_written,[]);
{ vsf_must_be_valid so it doesn't get changed into }
{ vsf_referred_not_inited }
set_varstate(left,vs_read,[vsf_must_be_valid]);
if not jvmimplicitpointertype(left.resultdef) then
begin
CGMessage(parser_e_illegal_expression);
exit
end;
result:=inherited;
end;
end;
@ -174,7 +197,10 @@ implementation
st_widestring:
stringclass:=java_jlstring;
st_shortstring:
stringclass:=java_shortstring;
begin
stringclass:=java_shortstring;
left:=caddrnode.create_internal(left);
end
else
internalerror(2011052407);
end;
@ -267,8 +293,9 @@ implementation
begin
cderefnode:=tjvmderefnode;
caddrnode:=tjvmaddrnode;
cvecnode:=tjvmvecnode;
cloadparentfpnode:=tjvmloadparentfpnode;
cloadvmtaddrnode:=tjvmloadvmtaddrnode;
caddrnode:=tjvmaddrnode;
end.

7
compiler/jvmdef.pas
View File

@ -236,13 +236,12 @@ implementation
end;
pointerdef :
begin
{$ifndef nounsupported}
if def=voidpointertype then
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror)
else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror)
else
{$endif}
{ some may be handled via wrapping later }
result:=false;
result:=false;
end;
floatdef :
begin

19
compiler/ncnv.pas
View File

@ -255,6 +255,7 @@ interface
}
call: tnode;
constructor create(l,r : tnode);virtual;
constructor create_internal(l,r : tnode);virtual;
function pass_1 : tnode;override;
function dogetcopy: tnode;override;
function docompare(p: tnode): boolean; override;
@ -264,6 +265,7 @@ interface
tisnode = class(tasisnode)
constructor create(l,r : tnode);virtual;
constructor create_internal(l,r : tnode);virtual;
function pass_1 : tnode;override;
procedure pass_generate_code;override;
end;
@ -3702,6 +3704,15 @@ implementation
inherited create(isn,l,r);
end;
constructor tisnode.create_internal(l, r: tnode);
begin
create(l,r);
include(flags,nf_internal);
end;
function tisnode.pass_1 : tnode;
var
procname: string;
@ -3758,6 +3769,14 @@ implementation
end;
constructor tasnode.create_internal(l,r : tnode);
begin
create(l,r);
include(flags,nf_internal);
end;
destructor tasnode.destroy;
begin

4
compiler/symcreat.pas
View File

@ -255,7 +255,7 @@ implementation
internalerror(2011032812);
{ the inherited clone will already copy all fields in a shallow way ->
copy records/regular arrays in a regular way }
str:='begin clone:=inherited;';
str:='type _fpc_ptrt = ^'+struct.typesym.realname+'; begin clone:=inherited;';
for i:=0 to struct.symtable.symlist.count-1 do
begin
sym:=tsym(struct.symtable.symlist[i]);
@ -267,7 +267,7 @@ implementation
not is_dynamic_array(fsym.vardef)) or
((fsym.vardef.typ=setdef) and
not is_smallset(fsym.vardef)) then
str:=str+struct.typesym.realname+'(clone).'+fsym.realname+':='+fsym.realname+';';
str:=str+'_fpc_ptrt(clone)^.'+fsym.realname+':='+fsym.realname+';';
end;
end;
str:=str+'end;';

24
compiler/symdef.pas
View File

@ -1616,10 +1616,7 @@ implementation
(d=java_jlstring))) or
((stringtype=st_ansistring) and
((d=java_jlobject) or
(d=java_ansistring))) or
((stringtype=st_shortstring) and
((d=java_jlobject) or
(d=java_shortstring))));
(d=java_ansistring))));
end;
@ -3168,16 +3165,19 @@ implementation
function trecorddef.is_related(d: tdef): boolean;
begin
if d.typ=objectdef then
d:=find_real_class_definition(tobjectdef(d),false);
{ records are implemented via classes in the JVM target, and are
all descendents of the java_fpcbaserecordtype class }
if (target_info.system=system_jvm_java32) and
((d=java_jlobject) or
(d=java_fpcbaserecordtype)) then
is_related:=true
else
is_related:=false;
is_related:=false;
if (target_info.system=system_jvm_java32) then
begin
if d.typ=objectdef then
begin
d:=find_real_class_definition(tobjectdef(d),false);
if (d=java_jlobject) or
(d=java_fpcbaserecordtype) then
is_related:=true
end;
end;
end;

10
rtl/java/astrings.inc
View File

@ -52,7 +52,7 @@ end;
constructor AnsistringClass.Create(const s: shortstring);
begin
Create(ShortstringClass(s).fdata);
Create(ShortstringClass(@s).fdata);
end;
@ -99,7 +99,7 @@ end;
function AnsistringClass.toShortstring(maxlen: byte): shortstring;
begin
result:=shortstring(ShortstringClass.Create(ansistring(self),maxlen));
result:=pshortstring(ShortstringClass.Create(ansistring(self),maxlen))^;
end;
@ -217,7 +217,7 @@ begin
Size:=Length(S2);
If Size>high(res) then
Size:=high(res);
JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(res).fdata),0,Size);
JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(@res).fdata),0,Size);
setlength(res,Size);
end;
end;
@ -233,7 +233,7 @@ begin
Size:=Length(S2);
Setlength (result,Size);
if Size>0 then
JLSystem.ArrayCopy(JLObject(ShortstringClass(S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
end;
@ -447,7 +447,7 @@ begin
ofs:=Length(S);
SetLength(S,ofs+length(Str));
{ the pbyte cast avoids an unique call which isn't necessary because SetLength was just called }
JLSystem.ArrayCopy(JLObject(ShortstringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
end;
Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;

70
rtl/java/sstrings.inc
View File

@ -69,7 +69,7 @@ begin
if system.length(s)=0 then
exit;
curlen:=min(system.length(s),maxlen);
JLSystem.ArrayCopy(JLObject(ShortstringClass(s).fdata),0,JLObject(fdata),0,min(system.length(s),maxlen));
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),0,JLObject(fdata),0,min(system.length(s),maxlen));
end;
@ -101,10 +101,10 @@ var
i: longint;
begin
{ used to construct constant shortstrings from Java string constants }
ShortstringClass(result).curlen:=min(system.length(u),255);
setlength(ShortstringClass(result).fdata,ShortstringClass(result).curlen);
for i:=1 to ShortstringClass(result).curlen do
ShortstringClass(result).fdata[i-1]:=ansichar(ord(u[i]));
ShortstringClass(@result).curlen:=min(system.length(u),255);
setlength(ShortstringClass(@result).fdata,ShortstringClass(@result).curlen);
for i:=1 to ShortstringClass(@result).curlen do
ShortstringClass(@result).fdata[i-1]:=ansichar(ord(u[i]));
end;
@ -149,7 +149,7 @@ end;
function ShortstringClass.toAnsistring: ansistring;
begin
result:=ansistring(AnsistringClass.Create(shortstring(self)));
result:=ansistring(AnsistringClass.Create(pshortstring(self)^));
end;
@ -164,7 +164,7 @@ end;
function ShortstringClass.clone: JLObject;
begin
result:=ShortstringClass.Create(Shortstring(self),system.length(fdata));
result:=ShortstringClass.Create(pshortstring(self)^,system.length(fdata));
end;
@ -189,7 +189,7 @@ procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
begin
if len>255 then
len:=255;
ShortstringClass(s).curlen:=len;
ShortstringClass(@s).curlen:=len;
end;
@ -200,8 +200,8 @@ begin
len:=length(sstr);
if len>high(res) then
len:=high(res);
ShortstringClass(res).curlen:=len;
JLSystem.ArrayCopy(JLObject(ShortstringClass(sstr).fdata),0,JLObject(ShortstringClass(res).fdata),0,len);
ShortstringClass(@res).curlen:=len;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@sstr).fdata),0,JLObject(ShortstringClass(@res).fdata),0,len);
end;
@ -218,19 +218,19 @@ begin
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
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);
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)
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;
ShortstringClass(@dests).curlen:=s1l+s2l;
end;
@ -249,14 +249,14 @@ begin
exit;
end;
lowstart:=low(sarr);
if ShortstringClass(DestS)=sarr[lowstart] then
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
if ShortstringClass(@DestS)=sarr[i] then
begin
needtemp:=true;
break;
@ -266,7 +266,7 @@ begin
begin
lowstart:=low(sarr);
tmpstr:='';
pdest:=ShortstringClass(tmpstr)
pdest:=ShortstringClass(@tmpstr)
end
else
begin
@ -274,7 +274,7 @@ begin
the first array element }
if lowstart=low(sarr) then
DestS:='';
pdest:=ShortstringClass(DestS);
pdest:=ShortstringClass(@DestS);
end;
{ Concat all strings, except the string we already
copied in DestS }
@ -305,7 +305,7 @@ begin
s2l:=length(s2);
if s1l+s2l>high(s1) then
s2l:=high(s1)-s1l;
JLSystem.ArrayCopy(JLObject(ShortstringClass(s2).fdata),0,JLObject(ShortstringClass(s1).fdata),s1l,s2l);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@s1).fdata),s1l,s2l);
s1[0]:=chr(s1l+s2l);
end;
@ -314,7 +314,7 @@ function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerp
Var
MaxI,Temp, i : SizeInt;
begin
if ShortstringClass(left)=ShortstringClass(right) then
if ShortstringClass(@left)=ShortstringClass(@right) then
begin
result:=0;
exit;
@ -327,7 +327,7 @@ begin
begin
for i:=0 to MaxI-1 do
begin
result:=ord(ShortstringClass(left).fdata[i])-ord(ShortstringClass(right).fdata[i]);
result:=ord(ShortstringClass(@left).fdata[i])-ord(ShortstringClass(@right).fdata[i]);
if result<>0 then
exit;
end;
@ -342,12 +342,12 @@ function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; com
Var
MaxI,Temp : SizeInt;
begin
if ShortstringClass(left)=ShortstringClass(right) then
if ShortstringClass(@left)=ShortstringClass(@right) then
begin
result:=0;
exit;
end;
result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(left).fdata),TJByteArray(ShortstringClass(right).fdata)));
result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(@left).fdata),TJByteArray(ShortstringClass(@right).fdata)));
end;
@ -379,8 +379,8 @@ begin
end
else
len:=l;
JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(res).fdata),0,len);
ShortstringClass(res).curlen:=len;
JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(@res).fdata),0,len);
ShortstringClass(@res).curlen:=len;
end;
@ -393,7 +393,7 @@ begin
len:=length(res);
{ make sure we don't access char 1 if length is 0 (JM) }
if len>0 then
JLSystem.ArrayCopy(JLObject(ShortstringClass(src).fdata),0,JLObject(@res),0,len);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@res),0,len);
JUArrays.fill(TJByteArray(@res),len,high(res),0);
end;
@ -405,7 +405,7 @@ procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compile
begin
setlength(res,1);
ShortstringClass(res).fdata[0]:=c;
ShortstringClass(@res).fdata[0]:=c;
end;
@ -422,8 +422,8 @@ begin
else
if count>length(s)-index then
count:=length(s)-index;
ShortstringClass(result).curlen:=count;
JLSystem.ArrayCopy(JLObject(ShortstringClass(s).fdata),index,JLObject(ShortstringClass(result).fdata),0,count);
ShortstringClass(@result).curlen:=count;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),index,JLObject(ShortstringClass(@result).fdata),0,count);
end;
@ -470,7 +470,7 @@ begin
j:=0;
k:=i-1;
while (j<SubstrLen) and
(ShortstringClass(SubStr).fdata[j]=ShortstringClass(Source).fdata[k]) do
(ShortstringClass(@SubStr).fdata[j]=ShortstringClass(@Source).fdata[k]) do
begin
inc(j);
inc(k);
@ -495,7 +495,7 @@ var
begin
for i:=1 to length(s) do
begin
if ShortstringClass(s).fdata[i-1]=c then
if ShortstringClass(@s).fdata[i-1]=c then
begin
pos:=i;
exit;

6
rtl/java/system.pp
View File

@ -24,7 +24,7 @@ Unit system;
{$define FPC_IS_SYSTEM}
{$I-,Q-,H-,R-,V-,P+}
{$I-,Q-,H-,R-,V-,P+,T+}
{$implicitexceptions off}
{$mode objfpc}
@ -55,11 +55,13 @@ Type
AnsiChar = Char;
UnicodeChar = WideChar;
{ map comp to int64, }
{ map comp to int64 }
Comp = Int64;
HResult = type longint;
PShortString = ^ShortString;
{ Java primitive types }
jboolean = boolean;
jbyte = shortint;

2
rtl/java/ustrings.inc
View File

@ -64,7 +64,7 @@ begin
result:='';
Size:=Length(S2);
if Size>0 then
result:=unicodestring(JLString.Create(TJByteArray(ShortstringClass(S2).fdata),0,length(S2)));
result:=unicodestring(JLString.Create(TJByteArray(ShortstringClass(@S2).fdata),0,length(S2)));
end;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;