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

* allow specifying an external name for fields in external Java classes/

Browse Source 
interfaces using "var f: field; external name 'xxx';" (necessary for
    solving identifier clashes in imported classes)

git-svn-id: branches/jvmbackend@18406 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:57:03 +00:00
parent 8199b2c6a9
commit f384c274bb
3 changed files with 81 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/jvmdef.pas
View File

@ -61,6 +61,7 @@ interface
{ returns the mangled base name for a tsym (type + symbol name, no
visibility etc) }
function jvmmangledbasename(sym: tsym): string;
function jvmmangledbasename(sym: tsym; const usesymname: string): string;
implementation
@ -326,7 +327,7 @@ implementation
end;
function jvmmangledbasename(sym: tsym): string;
function jvmmangledbasename(sym: tsym; const usesymname: string): string;
var
vsym: tabstractvarsym;
csym: tconstsym;
@ -347,13 +348,13 @@ implementation
([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
result:='result '+result
else
result:=vsym.realname+' '+result;
result:=usesymname+' '+result;
end;
constsym:
begin
csym:=tconstsym(sym);
result:=jvmencodetype(csym.constdef);
result:=csym.realname+' '+result;
result:=usesymname+' '+result;
end;
else
internalerror(2011021703);
@ -361,6 +362,15 @@ implementation
end;
function jvmmangledbasename(sym: tsym): string;
begin
if (sym.typ=fieldvarsym) and
assigned(tfieldvarsym(sym).externalname) then
result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^)
else
result:=jvmmangledbasename(sym,sym.RealName);
end;
{******************************************************************
jvm type validity checking
*******************************************************************}

36
compiler/pdecvar.pas
View File

@ -1085,6 +1085,32 @@ implementation
end;
procedure try_read_field_external(vs: tabstractvarsym);
var
extname: string;
begin
if try_to_consume(_EXTERNAL) then
begin
consume(_NAME);
extname:=get_stringconst;
tfieldvarsym(vs).set_externalname(extname);
consume(_SEMICOLON);
end;
end;
procedure try_read_field_external_sc(sc:TFPObjectList);
var
vs: tabstractvarsym;
begin
{ only allowed for one var }
vs:=tabstractvarsym(sc[0]);
if sc.count>1 then
Message1(parser_e_directive_only_one_var,arraytokeninfo[idtoken].str);
try_read_field_external(vs);
end;
procedure read_var_decls(options:Tvar_dec_options);
procedure read_default_value(sc : TFPObjectList);
@ -1652,7 +1678,6 @@ implementation
(hdef.typesym=nil) then
handle_calling_convention(tprocvardef(hdef));
{ check if it is a class field }
if (vd_object in options) then
begin
{ if it is not a class var section and token=STATIC then it is a class field too }
@ -1661,6 +1686,11 @@ implementation
consume(_SEMICOLON);
include(options, vd_class);
end;
{ Fields in Java classes/interfaces can have a separately
specified external name }
if is_java_class_or_interface(tdef(recst.defowner)) and
(oo_is_external in tobjectdef(recst.defowner).objectoptions) then
try_read_field_external_sc(sc);
end;
if vd_class in options then
begin
@ -1690,6 +1720,10 @@ implementation
inserting the new one }
fieldvs.Rename(internal_static_field_name(fieldvs.name));
recst.insert(hstaticvs);
{ has to be delayed until now, because the calculated
mangled name depends on the owner }
if (vo_has_mangledname in fieldvs.varoptions) then
hstaticvs.set_mangledname(fieldvs.externalname^);
{$endif not jvm}
if vd_final in options then
hstaticvs.varspez:=vs_final;

34
compiler/symsym.pas
View File

@ -156,10 +156,12 @@ interface
tfieldvarsym = class(tabstractvarsym)
fieldoffset : asizeint; { offset in record/object }
externalname : pshortstring;
cachedmangledname: pshortstring; { mangled name for ObjC or Java }
constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure set_externalname(const s:string);
function mangledname:string;override;
destructor destroy;override;
end;
@ -1201,6 +1203,10 @@ implementation
begin
inherited ppuload(fieldvarsym,ppufile);
fieldoffset:=ppufile.getaint;
if (vo_has_mangledname in varoptions) then
externalname:=stringdup(ppufile.getstring)
else
externalname:=nil;
end;
@ -1208,10 +1214,30 @@ implementation
begin
inherited ppuwrite(ppufile);
ppufile.putaint(fieldoffset);
if (vo_has_mangledname in varoptions) then
ppufile.putstring(externalname^);
ppufile.writeentry(ibfieldvarsym);
end;
procedure tfieldvarsym.set_externalname(const s: string);
var
tmp: string;
begin
{ make sure it is recalculated }
stringdispose(cachedmangledname);
{$ifdef jvm}
if is_java_class_or_interface(tdef(owner.defowner)) then
begin
externalname:=stringdup(s);
include(varoptions,vo_has_mangledname);
end
else
{$endif jvm}
internalerror(2011031201);
end;
function tfieldvarsym.mangledname:string;
var
srsym : tsym;
@ -1402,10 +1428,16 @@ implementation
procedure tstaticvarsym.set_mangledname(const s:string);
{$ifdef jvm}
var
tmpname: string;
{$endif}
begin
stringdispose(_mangledname);
{$if defined(jvm)}
internalerror(2011011202);
tmpname:=jvmmangledbasename(self,s);
jvmaddtypeownerprefix(owner,tmpname);
_mangledname:=stringdup(tmpname);
{$elseif defined(compress)}
_mangledname:=stringdup(minilzw_encode(s));
{$else}