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

* put the code to generate the default mangled name for procdefs into

Browse Source 
a separate method (defaultmangledname)
  * for the jvm target, call jvmmangledname() instead of defaultmangledname()
    from mangledname()
  * make non-strict private and protected methods "public" in the Java bytecode,
    because a single Java class file contains only code from one class, and such
    methods can be accessed from other classes in the same unit too
  * minor fixes to the jvm mangled name generation

git-svn-id: branches/jvmbackend@18303 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:36:54 +00:00
parent 35ca5b799b
commit 9fc3616179
1 changed files with 49 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
compiler/symdef.pas
View File

@ -571,6 +571,7 @@ interface
function mangledname(fordefinition: boolean) : string; function mangledname(fordefinition: boolean) : string;
procedure setmangledname(const s : string); procedure setmangledname(const s : string);
function fullprocname(showhidden:boolean):string; function fullprocname(showhidden:boolean):string;
function defaultmangledname: string;
function cplusplusmangledname : string; function cplusplusmangledname : string;
function objcmangledname : string; function objcmangledname : string;
function jvmmangledname: string; function jvmmangledname: string;
@ -3933,13 +3934,6 @@ implementation
function tprocdef.mangledname(fordefinition: boolean) : string; function tprocdef.mangledname(fordefinition: boolean) : string;
var
hp : TParavarsym;
hs : string;
crc : dword;
newlen,
oldlen,
i : integer;
begin begin
if assigned(_mangledname) then if assigned(_mangledname) then
begin begin
@ -3951,22 +3945,45 @@ implementation
adornmangledname(mangledname,fordefinition); adornmangledname(mangledname,fordefinition);
exit; exit;
end; end;
{$ifndef jvm}
mangledname:=defaultmangledname;
{$else not jvm}
mangledname:=jvmmangledname;
{$endif not jvm}
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(mangledname));
{$else}
_mangledname:=stringdup(mangledname);
{$endif}
adornmangledname(mangledname,fordefinition);
end;
function tprocdef.defaultmangledname: string;
var
hp : TParavarsym;
hs : string;
crc : dword;
newlen,
oldlen,
i : integer;
begin
{ we need to use the symtable where the procsym is inserted, { we need to use the symtable where the procsym is inserted,
because that is visible to the world } because that is visible to the world }
mangledname:=make_mangledname('',procsym.owner,procsym.name); defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
oldlen:=length(mangledname); oldlen:=length(defaultmangledname);
{ add parameter types } { add parameter types }
for i:=0 to paras.count-1 do for i:=0 to paras.count-1 do
begin begin
hp:=tparavarsym(paras[i]); hp:=tparavarsym(paras[i]);
if not(vo_is_hidden_para in hp.varoptions) then if not(vo_is_hidden_para in hp.varoptions) then
mangledname:=mangledname+'$'+hp.vardef.mangledparaname; defaultmangledname:=defaultmangledname+'$'+hp.vardef.mangledparaname;
end; end;
{ add resultdef, add $$ as separator to make it unique from a { add resultdef, add $$ as separator to make it unique from a
parameter separator } parameter separator }
if not is_void(returndef) then if not is_void(returndef) then
mangledname:=mangledname+'$$'+returndef.mangledparaname; defaultmangledname:=defaultmangledname+'$$'+returndef.mangledparaname;
newlen:=length(mangledname); newlen:=length(defaultmangledname);
{ Replace with CRC if the parameter line is very long } { Replace with CRC if the parameter line is very long }
if (newlen-oldlen>12) and if (newlen-oldlen>12) and
((newlen>100) or (newlen-oldlen>64)) then ((newlen>100) or (newlen-oldlen>64)) then
@ -3983,14 +4000,8 @@ implementation
end; end;
hs:=hp.vardef.mangledparaname; hs:=hp.vardef.mangledparaname;
crc:=UpdateCrc32(crc,hs[1],length(hs)); crc:=UpdateCrc32(crc,hs[1],length(hs));
mangledname:=Copy(mangledname,1,oldlen)+'$crc'+hexstr(crc,8); defaultmangledname:=Copy(defaultmangledname,1,oldlen)+'$crc'+hexstr(crc,8);
end; end;
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(mangledname));
{$else}
_mangledname:=stringdup(mangledname);
{$endif}
adornmangledname(mangledname,fordefinition);
end; end;
@ -4171,8 +4182,11 @@ implementation
procedure tprocdef.adornmangledname(var name: string; fordefinition: boolean); procedure tprocdef.adornmangledname(var name: string; fordefinition: boolean);
{$ifdef jvm}
var var
owningunit:tsymtable;
tmpresult:string; tmpresult:string;
{$endif jvm}
begin begin
{$ifdef jvm} {$ifdef jvm}
{ see tprocdef.jvmmangledname for description of the format } { see tprocdef.jvmmangledname for description of the format }
@ -4180,12 +4194,13 @@ implementation
begin begin
{ definition: visibility/static } { definition: visibility/static }
case visibility of case visibility of
vis_private, vis_hidden,
vis_strictprivate: vis_strictprivate:
tmpresult:='private '; tmpresult:='private ';
vis_protected,
vis_strictprotected: vis_strictprotected:
tmpresult:='protected '; tmpresult:='protected ';
vis_protected,
vis_private,
vis_public: vis_public:
tmpresult:='public '; tmpresult:='public ';
else else
@ -4207,29 +4222,29 @@ implementation
while (owningunit.symtabletype in [localsymtable,objectsymtable,recordsymtable]) do while (owningunit.symtabletype in [localsymtable,objectsymtable,recordsymtable]) do
owningunit:=owner.defowner.owner; owningunit:=owner.defowner.owner;
{ TODO: add package name !!! } { TODO: add package name !!! }
tmpresult:=owningunit.realname^; tmpresult:=owningunit.realname^+'/';
end; end;
objectsymtable: objectsymtable:
case tobjectdef(procsym.owner.defowner).objecttype of case tobjectdef(procsym.owner.defowner).objecttype of
odt_javaclass, odt_javaclass,
odt_interfacejava: odt_interfacejava:
tmpresult:=tobjectdef(procsym.owner.defowner).objextname^; tmpresult:=tobjectdef(procsym.owner.defowner).objextname^+'/';
else else
internalerror(2010122606); internalerror(2010122606);
end end
else else
internalerror(2010122605); internalerror(2010122605);
end; end;
if po_has_importname in procoptions then if po_has_importdll in procoptions then
begin begin
{ import_dll comes from "external 'import_dll_name' name 'external_name'" } { import_dll comes from "external 'import_dll_name' name 'external_name'" }
if assigned(import_dll) then if assigned(import_dll) then
tmpresult:=result+import_dll^+'/' tmpresult:=tmpresult+import_dll^+'/'
else else
internalerror(2010122607); internalerror(2010122607);
end; end;
end; end;
name:=name+tmpresult; name:=tmpresult+name;
{$endif} {$endif}
end; end;
@ -4252,21 +4267,20 @@ implementation
adorn as required when using it. adorn as required when using it.
} }
{ method name } { method name }
if po_has_importname in procoptions then { special names for constructors and class constructors }
if proctypeoption=potype_constructor then
tmpresult:='<init>'
else if proctypeoption=potype_class_constructor then
tmpresult:='<clinit>'
else if po_has_importname in procoptions then
begin begin
if assigned(import_name) then if assigned(import_name) then
tmpresult:=result+import_name^ tmpresult:=import_name^
else else
internalerror(2010122608); internalerror(2010122608);
end end
else else
begin tmpresult:=procsym.realname;
{ package name must be set for all external routines }
if po_external in procoptions then
internalerror(2010122607);
{ TODO: add current package name! }
tmpresult:=result+procsym.realname;
end;
{ parameter types } { parameter types }
tmpresult:=tmpresult+'('; tmpresult:=tmpresult+'(';
init_paraloc_info(callerside); init_paraloc_info(callerside);