mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 01:11:29 +01:00
1014 lines
35 KiB
ObjectPascal
1014 lines
35 KiB
ObjectPascal
{
|
||
Copyright (c) 2010 by Jonas Maebe
|
||
|
||
This unit implements some JVM type helper routines (minimal
|
||
unit dependencies, usable in symdef).
|
||
|
||
This program is free software; you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation; either version 2 of the License, or
|
||
(at your option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with this program; if not, write to the Free Software
|
||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||
|
||
****************************************************************************
|
||
}
|
||
|
||
{$i fpcdefs.inc}
|
||
|
||
unit jvmdef;
|
||
|
||
interface
|
||
|
||
uses
|
||
globtype,
|
||
node,
|
||
symbase,symtype;
|
||
|
||
{ returns whether a def can make use of an extra type signature (for
|
||
Java-style generics annotations; not use for FPC-style generics or their
|
||
translations, but to annotate the kind of classref a java.lang.Class is
|
||
and things like that) }
|
||
function jvmtypeneedssignature(def: tdef): boolean;
|
||
{ create a signature encoding of a particular type; requires that
|
||
jvmtypeneedssignature returned "true" for this type }
|
||
procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
|
||
|
||
{ Encode a type into the internal format used by the JVM (descriptor).
|
||
Returns false if a type is not representable by the JVM,
|
||
and in that case also the failing definition. }
|
||
function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
|
||
|
||
{ same as above, but throws an internal error on failure }
|
||
function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
|
||
|
||
{ Check whether a type can be used in a JVM methom signature or field
|
||
declaration. }
|
||
function jvmchecktype(def: tdef; out founderror: tdef): boolean;
|
||
|
||
{ incremental version of jvmtryencodetype() }
|
||
function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
|
||
|
||
{ add type prefix (package name) to a type }
|
||
procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
|
||
|
||
{ returns type string for a single-dimensional array (different from normal
|
||
typestring in case of a primitive type) }
|
||
function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
|
||
function jvmarrtype_setlength(def: tdef): char;
|
||
|
||
{ returns whether a def is emulated using an implicit pointer type on the
|
||
JVM target (e.g., records, regular arrays, ...) }
|
||
function jvmimplicitpointertype(def: tdef): boolean;
|
||
|
||
{ returns the mangled base name for a tsym (type + symbol name, no
|
||
visibility etc); also adds signature attribute if requested and
|
||
appropriate }
|
||
function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
|
||
function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
|
||
|
||
{ sometimes primitive types have to be boxed/unboxed via class types. This
|
||
routine returns the appropriate box type for the passed primitive type }
|
||
procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
|
||
function jvmgetunboxmethod(def: tdef): string;
|
||
|
||
function jvmgetcorrespondingclassdef(def: tdef): tdef;
|
||
|
||
function get_para_push_size(def: tdef): tdef;
|
||
|
||
{ threadvars are wrapped via descendents of java.lang.ThreadLocal }
|
||
function jvmgetthreadvardef(def: tdef): tdef;
|
||
|
||
{ gets the number of dimensions and the final element type of a normal
|
||
array }
|
||
procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
|
||
|
||
|
||
implementation
|
||
|
||
uses
|
||
cutils,cclasses,constexp,
|
||
verbose,systems,
|
||
fmodule,
|
||
symtable,symconst,symsym,symdef,symcpu,symcreat,
|
||
defutil,paramgr;
|
||
|
||
{******************************************************************
|
||
Type encoding
|
||
*******************************************************************}
|
||
|
||
function jvmtypeneedssignature(def: tdef): boolean;
|
||
var
|
||
i: longint;
|
||
begin
|
||
result:=false;
|
||
case def.typ of
|
||
classrefdef,
|
||
setdef:
|
||
begin
|
||
result:=true;
|
||
end;
|
||
arraydef :
|
||
begin
|
||
result:=jvmtypeneedssignature(tarraydef(def).elementdef);
|
||
end;
|
||
procvardef :
|
||
begin
|
||
{ may change in the future }
|
||
end;
|
||
procdef :
|
||
begin
|
||
for i:=0 to tprocdef(def).paras.count-1 do
|
||
begin
|
||
result:=jvmtypeneedssignature(tparavarsym(tprocdef(def).paras[i]).vardef);
|
||
if result then
|
||
exit;
|
||
end;
|
||
end
|
||
else
|
||
result:=false;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
|
||
var
|
||
founderror: tdef;
|
||
begin
|
||
case def.typ of
|
||
pointerdef :
|
||
begin
|
||
{ maybe one day }
|
||
internalerror(2011051403);
|
||
end;
|
||
classrefdef :
|
||
begin
|
||
{ Ljava/lang/Class<+SomeClassType> means
|
||
"Ljava/lang/Class<SomeClassType_or_any_of_its_descendents>" }
|
||
encodedstr:=encodedstr+'Ljava/lang/Class<+';
|
||
jvmaddencodedtype(tclassrefdef(def).pointeddef,false,encodedstr,true,founderror);
|
||
encodedstr:=encodedstr+'>;';
|
||
end;
|
||
setdef :
|
||
begin
|
||
if tsetdef(def).elementdef.typ=enumdef then
|
||
begin
|
||
encodedstr:=encodedstr+'Ljava/util/EnumSet<';
|
||
jvmaddencodedtype(tenumdef(tsetdef(def).elementdef).getbasedef,false,encodedstr,true,founderror);
|
||
encodedstr:=encodedstr+'>;';
|
||
end
|
||
else
|
||
internalerror(2011051404);
|
||
end;
|
||
arraydef :
|
||
begin
|
||
if is_array_of_const(def) then
|
||
begin
|
||
internalerror(2011051405);
|
||
end
|
||
else if is_packed_array(def) then
|
||
begin
|
||
internalerror(2011051406);
|
||
end
|
||
else
|
||
begin
|
||
encodedstr:=encodedstr+'[';
|
||
jvmaddencodedsignature(tarraydef(def).elementdef,false,encodedstr);
|
||
end;
|
||
end;
|
||
procvardef :
|
||
begin
|
||
{ maybe one day }
|
||
internalerror(2011051407);
|
||
end;
|
||
objectdef :
|
||
begin
|
||
{ maybe one day }
|
||
end;
|
||
undefineddef,
|
||
errordef :
|
||
begin
|
||
internalerror(2011051408);
|
||
end;
|
||
procdef :
|
||
{ must be done via jvmencodemethod() }
|
||
internalerror(2011051401);
|
||
else
|
||
internalerror(2011051402);
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
|
||
var
|
||
c: char;
|
||
begin
|
||
result:=true;
|
||
case def.typ of
|
||
stringdef :
|
||
begin
|
||
case tstringdef(def).stringtype of
|
||
{ translated into java.lang.String }
|
||
st_widestring,
|
||
st_unicodestring:
|
||
result:=jvmaddencodedtype(java_jlstring,false,encodedstr,forcesignature,founderror);
|
||
st_ansistring:
|
||
result:=jvmaddencodedtype(java_ansistring,false,encodedstr,forcesignature,founderror);
|
||
st_shortstring:
|
||
result:=jvmaddencodedtype(java_shortstring,false,encodedstr,forcesignature,founderror);
|
||
else
|
||
{ May be handled via wrapping later }
|
||
result:=false;
|
||
end;
|
||
end;
|
||
enumdef:
|
||
begin
|
||
result:=jvmaddencodedtype(tcpuenumdef(tenumdef(def).getbasedef).classdef,false,encodedstr,forcesignature,founderror);
|
||
end;
|
||
orddef :
|
||
begin
|
||
{ for procedure "results" }
|
||
if is_void(def) then
|
||
c:='V'
|
||
{ only Pascal-style booleans conform to Java's definition of
|
||
Boolean }
|
||
else if is_pasbool(def) and
|
||
(def.size=1) then
|
||
c:='Z'
|
||
else if is_widechar(def) then
|
||
c:='C'
|
||
else
|
||
begin
|
||
case def.size of
|
||
1:
|
||
c:='B';
|
||
2:
|
||
c:='S';
|
||
4:
|
||
c:='I';
|
||
8:
|
||
c:='J';
|
||
else
|
||
internalerror(2010121905);
|
||
end;
|
||
end;
|
||
encodedstr:=encodedstr+c;
|
||
end;
|
||
pointerdef :
|
||
begin
|
||
if is_voidpointer(def) 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
|
||
begin
|
||
{ all pointer types are emulated via arrays }
|
||
encodedstr:=encodedstr+'[';
|
||
result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror);
|
||
end
|
||
end;
|
||
floatdef :
|
||
begin
|
||
case tfloatdef(def).floattype of
|
||
s32real:
|
||
c:='F';
|
||
s64real:
|
||
c:='D';
|
||
else
|
||
begin
|
||
result:=false;
|
||
c:=' ';
|
||
end;
|
||
end;
|
||
encodedstr:=encodedstr+c;
|
||
end;
|
||
filedef :
|
||
result:=false;
|
||
recorddef :
|
||
begin
|
||
encodedstr:=encodedstr+'L'+trecorddef(def).jvm_full_typename(true)+';'
|
||
end;
|
||
variantdef :
|
||
begin
|
||
{ will be hanlded via wrapping later, although wrapping may
|
||
happen at higher level }
|
||
result:=false;
|
||
end;
|
||
classrefdef :
|
||
begin
|
||
if not forcesignature then
|
||
{ unfortunately, java.lang.Class is final, so we can't create
|
||
different versions for difference class reference types }
|
||
encodedstr:=encodedstr+'Ljava/lang/Class;'
|
||
{ we can however annotate it with extra signature information in
|
||
using Java's generic annotations }
|
||
else
|
||
jvmaddencodedsignature(def,false,encodedstr);
|
||
result:=true;
|
||
end;
|
||
setdef :
|
||
begin
|
||
if tsetdef(def).elementdef.typ=enumdef then
|
||
begin
|
||
if forcesignature then
|
||
jvmaddencodedsignature(def,false,encodedstr)
|
||
else
|
||
result:=jvmaddencodedtype(java_juenumset,false,encodedstr,forcesignature,founderror)
|
||
end
|
||
else
|
||
result:=jvmaddencodedtype(java_jubitset,false,encodedstr,forcesignature,founderror)
|
||
end;
|
||
formaldef :
|
||
begin
|
||
{ var/const/out x: JLObject }
|
||
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror);
|
||
end;
|
||
arraydef :
|
||
begin
|
||
if is_array_of_const(def) then
|
||
begin
|
||
encodedstr:=encodedstr+'[';
|
||
result:=jvmaddencodedtype(search_system_type('TVARREC').typedef,false,encodedstr,forcesignature,founderror);
|
||
end
|
||
else if is_packed_array(def) then
|
||
result:=false
|
||
else
|
||
begin
|
||
encodedstr:=encodedstr+'[';
|
||
if not jvmaddencodedtype(tarraydef(def).elementdef,false,encodedstr,forcesignature,founderror) then
|
||
begin
|
||
result:=false;
|
||
{ report the exact (nested) error defintion }
|
||
exit;
|
||
end;
|
||
end;
|
||
end;
|
||
procvardef :
|
||
begin
|
||
result:=jvmaddencodedtype(tcpuprocvardef(def).classdef,false,encodedstr,forcesignature,founderror);
|
||
end;
|
||
objectdef :
|
||
case tobjectdef(def).objecttype of
|
||
odt_javaclass,
|
||
odt_interfacejava:
|
||
begin
|
||
def:=maybe_find_real_class_definition(def,false);
|
||
encodedstr:=encodedstr+'L'+tobjectdef(def).jvm_full_typename(true)+';'
|
||
end
|
||
else
|
||
result:=false;
|
||
end;
|
||
undefineddef,
|
||
errordef :
|
||
result:=false;
|
||
procdef :
|
||
{ must be done via jvmencodemethod() }
|
||
internalerror(2010121903);
|
||
else
|
||
internalerror(2010121904);
|
||
end;
|
||
if not result then
|
||
founderror:=def;
|
||
end;
|
||
|
||
|
||
function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
|
||
begin
|
||
encodedtype:='';
|
||
result:=jvmaddencodedtype(def,false,encodedtype,forcesignature,founderror);
|
||
end;
|
||
|
||
|
||
procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
|
||
var
|
||
owningcontainer: tsymtable;
|
||
tmpresult: TSymStr;
|
||
module: tmodule;
|
||
nameendpos: longint;
|
||
begin
|
||
{ see tprocdef.jvmmangledbasename for description of the format }
|
||
owningcontainer:=owner;
|
||
while (owningcontainer.symtabletype=localsymtable) do
|
||
owningcontainer:=owningcontainer.defowner.owner;
|
||
case owningcontainer.symtabletype of
|
||
globalsymtable,
|
||
staticsymtable:
|
||
begin
|
||
module:=find_module_from_symtable(owningcontainer);
|
||
tmpresult:='';
|
||
if assigned(module.namespace) then
|
||
tmpresult:=module.namespace^+'/';
|
||
tmpresult:=tmpresult+module.realmodulename^+'/';
|
||
end;
|
||
objectsymtable:
|
||
case tobjectdef(owningcontainer.defowner).objecttype of
|
||
odt_javaclass,
|
||
odt_interfacejava:
|
||
begin
|
||
tmpresult:=tobjectdef(owningcontainer.defowner).jvm_full_typename(true)+'/'
|
||
end
|
||
else
|
||
internalerror(2010122606);
|
||
end;
|
||
recordsymtable:
|
||
tmpresult:=trecorddef(owningcontainer.defowner).jvm_full_typename(true)+'/'
|
||
else
|
||
internalerror(2010122605);
|
||
end;
|
||
name:=tmpresult+name;
|
||
nameendpos:=pos(' ',name);
|
||
if nameendpos=0 then
|
||
nameendpos:=length(name)+1;
|
||
insert('''',name,nameendpos);
|
||
name:=''''+name;
|
||
end;
|
||
|
||
|
||
function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
|
||
var
|
||
errdef: tdef;
|
||
begin
|
||
if not jvmtryencodetype(def,result,false,errdef) then
|
||
internalerror(2011012205);
|
||
primitivetype:=false;
|
||
if length(result)=1 then
|
||
begin
|
||
case result[1] of
|
||
'Z': result:='boolean';
|
||
'C': result:='char';
|
||
'B': result:='byte';
|
||
'S': result:='short';
|
||
'I': result:='int';
|
||
'J': result:='long';
|
||
'F': result:='float';
|
||
'D': result:='double';
|
||
else
|
||
internalerror(2011012206);
|
||
end;
|
||
primitivetype:=true;
|
||
end
|
||
else if (result[1]='L') then
|
||
begin
|
||
{ in case of a class reference, strip the leading 'L' and the
|
||
trailing ';' }
|
||
setlength(result,length(result)-1);
|
||
delete(result,1,1);
|
||
end;
|
||
{ for arrays, use the actual reference type }
|
||
end;
|
||
|
||
|
||
function jvmarrtype_setlength(def: tdef): char;
|
||
var
|
||
errdef: tdef;
|
||
res: TSymStr;
|
||
begin
|
||
{ keep in sync with rtl/java/jdynarrh.inc and usage in njvminl }
|
||
if is_record(def) then
|
||
result:='R'
|
||
else if is_shortstring(def) then
|
||
result:='T'
|
||
else if def.typ=setdef then
|
||
begin
|
||
if tsetdef(def).elementdef.typ=enumdef then
|
||
result:='E'
|
||
else
|
||
result:='L'
|
||
end
|
||
else if (def.typ=procvardef) and
|
||
not tprocvardef(def).is_addressonly then
|
||
result:='P'
|
||
else
|
||
begin
|
||
if not jvmtryencodetype(def,res,false,errdef) then
|
||
internalerror(2011012209);
|
||
if length(res)=1 then
|
||
result:=res[1]
|
||
else
|
||
result:='A';
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmimplicitpointertype(def: tdef): boolean;
|
||
begin
|
||
case def.typ of
|
||
arraydef:
|
||
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
|
||
is_open_array(def) or
|
||
is_array_of_const(def) or
|
||
is_array_constructor(def);
|
||
recorddef,
|
||
setdef:
|
||
result:=true;
|
||
objectdef:
|
||
result:=is_object(def);
|
||
stringdef :
|
||
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
|
||
procvardef:
|
||
result:=not tprocvardef(def).is_addressonly;
|
||
else
|
||
result:=false;
|
||
end;
|
||
end;
|
||
|
||
|
||
{ mergeints = true means that all integer types are mapped to jllong,
|
||
otherwise they are mapped to the closest corresponding type }
|
||
procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
|
||
begin
|
||
case def.typ of
|
||
orddef:
|
||
begin
|
||
case torddef(def).ordtype of
|
||
pasbool8:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
|
||
paradef:=pasbool8type;
|
||
end;
|
||
uwidechar:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef);
|
||
paradef:=cwidechartype;
|
||
end;
|
||
else
|
||
begin
|
||
{ wrap all integer types into a JLLONG, so that we don't get
|
||
errors after returning a byte assigned to a long etc }
|
||
if mergeints or
|
||
(torddef(def).ordtype in [s64bit,u64bit,scurrency,bool64bit,pasbool64]) then
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLLONG').typedef);
|
||
paradef:=s64inttype;
|
||
end
|
||
else
|
||
begin
|
||
case torddef(def).ordtype of
|
||
s8bit,
|
||
u8bit,
|
||
uchar,
|
||
bool8bit:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLBYTE').typedef);
|
||
paradef:=s8inttype;
|
||
end;
|
||
s16bit,
|
||
u16bit,
|
||
bool16bit,
|
||
pasbool16:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLSHORT').typedef);
|
||
paradef:=s16inttype;
|
||
end;
|
||
s32bit,
|
||
u32bit,
|
||
bool32bit,
|
||
pasbool32:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLINTEGER').typedef);
|
||
paradef:=s32inttype;
|
||
end;
|
||
else
|
||
internalerror(2011052101);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
floatdef:
|
||
begin
|
||
case tfloatdef(def).floattype of
|
||
s32real:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLFLOAT').typedef);
|
||
paradef:=s32floattype;
|
||
end;
|
||
s64real:
|
||
begin
|
||
objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef);
|
||
paradef:=s64floattype;
|
||
end;
|
||
else
|
||
internalerror(2011052102);
|
||
end;
|
||
end;
|
||
else
|
||
internalerror(2011052103);
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmgetunboxmethod(def: tdef): string;
|
||
begin
|
||
case def.typ of
|
||
orddef:
|
||
begin
|
||
case torddef(def).ordtype of
|
||
pasbool8:
|
||
result:='BOOLEANVALUE';
|
||
s8bit,
|
||
u8bit,
|
||
uchar,
|
||
bool8bit:
|
||
result:='BYTEVALUE';
|
||
s16bit,
|
||
u16bit,
|
||
bool16bit,
|
||
pasbool16:
|
||
result:='SHORTVALUE';
|
||
s32bit,
|
||
u32bit,
|
||
bool32bit,
|
||
pasbool32:
|
||
result:='INTVALUE';
|
||
s64bit,
|
||
u64bit,
|
||
scurrency,
|
||
bool64bit,
|
||
pasbool64:
|
||
result:='LONGVALUE';
|
||
uwidechar:
|
||
result:='CHARVALUE';
|
||
else
|
||
internalerror(2011071702);
|
||
end;
|
||
end;
|
||
floatdef:
|
||
begin
|
||
case tfloatdef(def).floattype of
|
||
s32real:
|
||
result:='FLOATVALUE';
|
||
s64real:
|
||
result:='DOUBLEVALUE';
|
||
else
|
||
internalerror(2011071703);
|
||
end;
|
||
end;
|
||
else
|
||
internalerror(2011071704);
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmgetcorrespondingclassdef(def: tdef): tdef;
|
||
var
|
||
paradef: tdef;
|
||
begin
|
||
if def.typ in [orddef,floatdef] then
|
||
jvmgetboxtype(def,result,paradef,false)
|
||
else
|
||
begin
|
||
case def.typ of
|
||
stringdef :
|
||
begin
|
||
case tstringdef(def).stringtype of
|
||
{ translated into java.lang.String }
|
||
st_widestring,
|
||
st_unicodestring:
|
||
result:=java_jlstring;
|
||
st_ansistring:
|
||
result:=java_ansistring;
|
||
st_shortstring:
|
||
result:=java_shortstring;
|
||
else
|
||
internalerror(2011072409);
|
||
end;
|
||
end;
|
||
enumdef:
|
||
begin
|
||
result:=tcpuenumdef(tenumdef(def).getbasedef).classdef;
|
||
end;
|
||
pointerdef :
|
||
begin
|
||
if def=voidpointertype then
|
||
result:=java_jlobject
|
||
else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
|
||
result:=tpointerdef(def).pointeddef
|
||
else
|
||
internalerror(2011072410);
|
||
end;
|
||
recorddef :
|
||
begin
|
||
result:=def;
|
||
end;
|
||
variantdef :
|
||
begin
|
||
result:=cvarianttype;
|
||
end;
|
||
classrefdef :
|
||
begin
|
||
result:=search_system_type('JLCLASS').typedef;
|
||
end;
|
||
setdef :
|
||
begin
|
||
if tsetdef(def).elementdef.typ=enumdef then
|
||
result:=java_juenumset
|
||
else
|
||
result:=java_jubitset;
|
||
end;
|
||
formaldef :
|
||
begin
|
||
result:=java_jlobject;
|
||
end;
|
||
arraydef :
|
||
begin
|
||
{ cannot represent statically }
|
||
internalerror(2011072411);
|
||
end;
|
||
procvardef :
|
||
begin
|
||
result:=tcpuprocvardef(def).classdef;
|
||
end;
|
||
objectdef :
|
||
case tobjectdef(def).objecttype of
|
||
odt_javaclass,
|
||
odt_interfacejava:
|
||
result:=def
|
||
else
|
||
internalerror(2011072412);
|
||
end;
|
||
else
|
||
internalerror(2011072413);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
function get_para_push_size(def: tdef): tdef;
|
||
begin
|
||
result:=def;
|
||
if def.typ=orddef then
|
||
case torddef(def).ordtype of
|
||
u8bit,uchar:
|
||
if torddef(def).high>127 then
|
||
result:=s8inttype;
|
||
u16bit:
|
||
if torddef(def).high>32767 then
|
||
result:=s16inttype;
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmgetthreadvardef(def: tdef): tdef;
|
||
begin
|
||
if (def.typ=arraydef) and
|
||
not is_dynamic_array(def) then
|
||
begin
|
||
result:=search_system_type('FPCNORMALARRAYTHREADVAR').typedef;
|
||
exit;
|
||
end;
|
||
if jvmimplicitpointertype(def) then
|
||
begin
|
||
result:=search_system_type('FPCIMPLICITPTRTHREADVAR').typedef;
|
||
exit;
|
||
end;
|
||
case def.typ of
|
||
orddef:
|
||
begin
|
||
case torddef(def).ordtype of
|
||
pasbool8:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
|
||
end;
|
||
uwidechar:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCCHARTHREADVAR').typedef);
|
||
end;
|
||
s8bit,
|
||
u8bit,
|
||
uchar,
|
||
bool8bit:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCBYTETHREADVAR').typedef);
|
||
end;
|
||
s16bit,
|
||
u16bit,
|
||
bool16bit,
|
||
pasbool16:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCSHORTTHREADVAR').typedef);
|
||
end;
|
||
s32bit,
|
||
u32bit,
|
||
bool32bit,
|
||
pasbool32:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCINTTHREADVAR').typedef);
|
||
end;
|
||
s64bit,
|
||
u64bit,
|
||
scurrency,
|
||
bool64bit,
|
||
pasbool64:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCLONGTHREADVAR').typedef);
|
||
end
|
||
else
|
||
internalerror(2011082101);
|
||
end;
|
||
end;
|
||
floatdef:
|
||
begin
|
||
case tfloatdef(def).floattype of
|
||
s32real:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCFLOATTHREADVAR').typedef);
|
||
end;
|
||
s64real:
|
||
begin
|
||
result:=tobjectdef(search_system_type('FPCDOUBLETHREADVAR').typedef);
|
||
end;
|
||
else
|
||
internalerror(2011082102);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
result:=search_system_type('FPCPOINTERTHREADVAR').typedef
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
|
||
begin
|
||
eledef:=arrdef;
|
||
ndim:=0;
|
||
repeat
|
||
eledef:=tarraydef(eledef).elementdef;
|
||
inc(ndim);
|
||
until (eledef.typ<>arraydef) or
|
||
is_dynamic_array(eledef);
|
||
end;
|
||
|
||
|
||
|
||
function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
|
||
var
|
||
container: tsymtable;
|
||
vsym: tabstractvarsym;
|
||
csym: tconstsym;
|
||
usedef: tdef;
|
||
begin
|
||
case sym.typ of
|
||
staticvarsym,
|
||
paravarsym,
|
||
localvarsym,
|
||
fieldvarsym:
|
||
begin
|
||
vsym:=tabstractvarsym(sym);
|
||
{ for local and paravarsyms that are unsigned 8/16 bit, change the
|
||
outputted type to signed 16/32 bit:
|
||
a) the stack slots are all 32 bit anyway, so the storage allocation
|
||
is still correct
|
||
b) since at the JVM level all types are signed, this makes sure
|
||
that the values in the stack slots are valid for the specified
|
||
types
|
||
}
|
||
usedef:=vsym.vardef;
|
||
if vsym.typ in [localvarsym,paravarsym] then
|
||
begin
|
||
if (usedef.typ=orddef) then
|
||
case torddef(usedef).ordtype of
|
||
u8bit,uchar:
|
||
usedef:=s16inttype;
|
||
u16bit:
|
||
usedef:=s32inttype;
|
||
end;
|
||
end;
|
||
result:=jvmencodetype(usedef,false);
|
||
if withsignature and
|
||
jvmtypeneedssignature(usedef) then
|
||
begin
|
||
result:=result+' signature "';
|
||
result:=result+jvmencodetype(usedef,true)+'"';
|
||
end;
|
||
if (vsym.typ=paravarsym) and
|
||
(vo_is_self in tparavarsym(vsym).varoptions) then
|
||
result:='''this'' ' +result
|
||
else if (vsym.typ in [paravarsym,localvarsym]) and
|
||
([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
|
||
result:='''result'' '+result
|
||
else
|
||
begin
|
||
{ add array indirection if required }
|
||
if (vsym.typ=paravarsym) and
|
||
((usedef.typ=formaldef) or
|
||
((vsym.varspez in [vs_var,vs_out,vs_constref]) and
|
||
not jvmimplicitpointertype(usedef))) then
|
||
result:='['+result;
|
||
{ single quotes for definitions to prevent clashes with Java
|
||
opcodes }
|
||
if withsignature then
|
||
result:=usesymname+''' '+result
|
||
else
|
||
result:=usesymname+' '+result;
|
||
{ we have to mangle staticvarsyms in localsymtables to
|
||
prevent name clashes... }
|
||
if (vsym.typ=staticvarsym) then
|
||
begin
|
||
container:=sym.Owner;
|
||
while (container.symtabletype=localsymtable) do
|
||
begin
|
||
if tdef(container.defowner).typ<>procdef then
|
||
internalerror(2011040303);
|
||
{ defid is added to prevent problem with overloads }
|
||
result:=tprocdef(container.defowner).procsym.realname+'$$'+tostr(tprocdef(container.defowner).defid)+'$'+result;
|
||
container:=container.defowner.owner;
|
||
end;
|
||
end;
|
||
if withsignature then
|
||
result:=''''+result
|
||
end;
|
||
end;
|
||
constsym:
|
||
begin
|
||
csym:=tconstsym(sym);
|
||
{ some constants can be untyped }
|
||
if assigned(csym.constdef) and
|
||
not(csym.consttyp in [constwstring,conststring]) then
|
||
begin
|
||
result:=jvmencodetype(csym.constdef,false);
|
||
if withsignature and
|
||
jvmtypeneedssignature(csym.constdef) then
|
||
begin
|
||
result:=result+' signature "';
|
||
result:=result+jvmencodetype(csym.constdef,true)+'"';
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
case csym.consttyp of
|
||
constord:
|
||
result:=jvmencodetype(s32inttype,withsignature);
|
||
constreal:
|
||
result:=jvmencodetype(s64floattype,withsignature);
|
||
constset:
|
||
internalerror(2011040701);
|
||
constpointer,
|
||
constnil:
|
||
result:=jvmencodetype(java_jlobject,withsignature);
|
||
constwstring,
|
||
conststring:
|
||
result:=jvmencodetype(java_jlstring,withsignature);
|
||
constresourcestring:
|
||
internalerror(2011040702);
|
||
else
|
||
internalerror(2011040703);
|
||
end;
|
||
end;
|
||
if withsignature then
|
||
result:=''''+usesymname+''' '+result
|
||
else
|
||
result:=usesymname+' '+result
|
||
end;
|
||
else
|
||
internalerror(2011021703);
|
||
end;
|
||
end;
|
||
|
||
|
||
function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
|
||
begin
|
||
if (sym.typ=fieldvarsym) and
|
||
assigned(tfieldvarsym(sym).externalname) then
|
||
result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^,withsignature)
|
||
else if (sym.typ=staticvarsym) and
|
||
(tstaticvarsym(sym).mangledbasename<>'') then
|
||
result:=jvmmangledbasename(sym,tstaticvarsym(sym).mangledbasename,withsignature)
|
||
else
|
||
result:=jvmmangledbasename(sym,sym.RealName,withsignature);
|
||
end;
|
||
|
||
{******************************************************************
|
||
jvm type validity checking
|
||
*******************************************************************}
|
||
|
||
function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
|
||
var
|
||
errordef: tdef;
|
||
begin
|
||
if not jvmtryencodetype(def,result,withsignature,errordef) then
|
||
internalerror(2011012305);
|
||
end;
|
||
|
||
|
||
function jvmchecktype(def: tdef; out founderror: tdef): boolean;
|
||
var
|
||
encodedtype: TSymStr;
|
||
begin
|
||
{ don't duplicate the code like in objcdef, since the resulting strings
|
||
are much shorter here so it's not worth it }
|
||
result:=jvmtryencodetype(def,encodedtype,false,founderror);
|
||
end;
|
||
|
||
|
||
end.
|