mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 23:13:44 +02:00
2cea723a0d
the defs and syms (recursively) referred by inline routines and by the WPO
info
o defs and syms are no longer added immediately to the module's deflist/
symlist, even if they are created as "registered". Instead,
"doregister=true" simply means "add it to the symbol table at the
top of the symtable stack"
o normally only when a sym/def is deref'ed, it gets added to the module
symlist/deflist and defid/symid gets a (unique) value
o in cases where we use(d) the defid to construct unique names within the
current module, you now have to call call the tdef.new unique_id_str()
method. If the def was not yet registered, we will reserve room for it
in the deflist (to get a unique id), but the defid gets set to a
negative value computed from its position in the deflist. Should it
have to be written to the ppu file later on, the defid will be
modified to the actual position in the deflist. For both values,
new unique_id_str() will return the same result so that references
to this def before and after actual registrations are the same (needed
for the JVM backend, but also a good principle in general)
Overall: don't directly use symid/defid anymore to get unique identifiers,
but use tdef.new unique_id_str() instead (if necessary, a similar routine
for tsym can be added)
The result is the ppu file size gets reduced significantly after its big
increase as a result of the high level typed constant builder (which creates
a lot of defs). The result is even more efficient than before, as other
unneeded defs/syms from the localsymtables don't get saved/restored anymore
either.
git-svn-id: trunk@32153 -
1025 lines
35 KiB
ObjectPascal
1025 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 :
|
||
begin
|
||
case tfiledef(def).filetyp of
|
||
ft_text:
|
||
result:=jvmaddencodedtype(search_system_type('TEXTREC').typedef,false,encodedstr,forcesignature,founderror);
|
||
ft_typed,
|
||
ft_untyped:
|
||
result:=jvmaddencodedtype(search_system_type('FILEREC').typedef,false,encodedstr,forcesignature,founderror);
|
||
else
|
||
internalerror(2015091406);
|
||
end;
|
||
end;
|
||
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);
|
||
filedef,
|
||
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);
|
||
{ unique_id_str is added to prevent problem with overloads }
|
||
result:=tprocdef(container.defowner).procsym.realname+'$$'+tprocdef(container.defowner).unique_id_str+'$'+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.
|