* moved all jvm-specific code from symsym to jvm/symcpu

git-svn-id: trunk@27384 -
This commit is contained in:
Jonas Maebe 2014-03-30 16:55:09 +00:00
parent 4a7e6b8b8f
commit 721fd887c3
2 changed files with 83 additions and 60 deletions

View File

@ -26,6 +26,7 @@ unit symcpu;
interface interface
uses uses
globtype,
symdef,symsym; symdef,symsym;
type type
@ -104,6 +105,8 @@ type
end; end;
tcpufieldvarsym = class(tfieldvarsym) tcpufieldvarsym = class(tfieldvarsym)
procedure set_externalname(const s: string); override;
function mangledname: TSymStr; override;
end; end;
tcpulocalvarsym = class(tlocalvarsym) tcpulocalvarsym = class(tlocalvarsym)
@ -113,6 +116,8 @@ type
end; end;
tcpustaticvarsym = class(tstaticvarsym) tcpustaticvarsym = class(tstaticvarsym)
procedure set_mangledname(const s: TSymStr); override;
function mangledname: TSymStr; override;
end; end;
tcpuabsolutevarsym = class(tabsolutevarsym) tcpuabsolutevarsym = class(tabsolutevarsym)
@ -133,6 +138,73 @@ type
implementation implementation
uses
verbose,cutils,
symtype,symconst,
jvmdef;
{****************************************************************************
tcpustaticvarsym
****************************************************************************}
procedure tcpustaticvarsym.set_mangledname(const s: TSymStr);
begin
inherited;
_mangledname:=jvmmangledbasename(self,s,false);
jvmaddtypeownerprefix(owner,_mangledname);
end;
function tcpustaticvarsym.mangledname: TSymStr;
begin
if _mangledname='' then
begin
if _mangledbasename='' then
_mangledname:=jvmmangledbasename(self,false)
else
_mangledname:=jvmmangledbasename(self,_mangledbasename,false);
jvmaddtypeownerprefix(owner,_mangledname);
end;
result:=_mangledname;
end;
{****************************************************************************
tcpufieldvarsym
****************************************************************************}
procedure tcpufieldvarsym.set_externalname(const s: string);
begin
{ make sure it is recalculated }
cachedmangledname:='';
if is_java_class_or_interface(tdef(owner.defowner)) then
begin
externalname:=stringdup(s);
include(varoptions,vo_has_mangledname);
end
else
internalerror(2011031201);
end;
function tcpufieldvarsym.mangledname: TSymStr;
begin
if is_java_class_or_interface(tdef(owner.defowner)) or
(tdef(owner.defowner).typ=recorddef) then
begin
if cachedmangledname<>'' then
result:=cachedmangledname
else
begin
result:=jvmmangledbasename(self,false);
jvmaddtypeownerprefix(owner,result);
cachedmangledname:=result;
end;
end
else
result:=inherited;
end;
begin begin
{ used tdef classes } { used tdef classes }
cfiledef:=tcpufiledef; cfiledef:=tcpufiledef;

View File

@ -203,7 +203,7 @@ interface
{ do not override this routine in platform-specific subclasses, { do not override this routine in platform-specific subclasses,
override ppuwrite_platform instead } override ppuwrite_platform instead }
procedure ppuwrite(ppufile:tcompilerppufile);override;final; procedure ppuwrite(ppufile:tcompilerppufile);override;final;
procedure set_externalname(const s:string); procedure set_externalname(const s:string);virtual;
function mangledname:TSymStr;override; function mangledname:TSymStr;override;
destructor destroy;override; destructor destroy;override;
end; end;
@ -258,7 +258,7 @@ interface
tparavarsymclass = class of tparavarsym; tparavarsymclass = class of tparavarsym;
tstaticvarsym = class(tabstractnormalvarsym) tstaticvarsym = class(tabstractnormalvarsym)
private protected
{$ifdef symansistr} {$ifdef symansistr}
_mangledbasename, _mangledbasename,
_mangledname : TSymStr; _mangledname : TSymStr;
@ -283,7 +283,7 @@ interface
function mangledname:TSymStr;override; function mangledname:TSymStr;override;
procedure set_mangledbasename(const s: TSymStr); procedure set_mangledbasename(const s: TSymStr);
function mangledbasename: TSymStr; function mangledbasename: TSymStr;
procedure set_mangledname(const s:TSymStr); procedure set_mangledname(const s:TSymStr);virtual;
procedure set_raw_mangledname(const s:TSymStr); procedure set_raw_mangledname(const s:TSymStr);
end; end;
tstaticvarsymclass = class of tstaticvarsym; tstaticvarsymclass = class of tstaticvarsym;
@ -453,9 +453,6 @@ implementation
systems, systems,
{ symtable } { symtable }
defutil,symtable, defutil,symtable,
{$ifdef jvm}
jvmdef,
{$endif}
fmodule, fmodule,
{ tree } { tree }
node, node,
@ -1671,21 +1668,7 @@ implementation
procedure tfieldvarsym.set_externalname(const s: string); procedure tfieldvarsym.set_externalname(const s: string);
begin begin
{ make sure it is recalculated } internalerror(2014033001);
{$ifdef symansistr}
cachedmangledname:='';
{$else symansistr}
stringdispose(cachedmangledname);
{$endif symansistr}
{$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; end;
@ -1694,21 +1677,6 @@ implementation
srsym : tsym; srsym : tsym;
srsymtable : tsymtable; srsymtable : tsymtable;
begin begin
{$ifdef jvm}
if is_java_class_or_interface(tdef(owner.defowner)) or
(tdef(owner.defowner).typ=recorddef) then
begin
if cachedmangledname<>'' then
result:=cachedmangledname
else
begin
result:=jvmmangledbasename(self,false);
jvmaddtypeownerprefix(owner,result);
cachedmangledname:=result;
end;
end
else
{$endif jvm}
if sp_static in symoptions then if sp_static in symoptions then
begin begin
if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then
@ -1903,11 +1871,9 @@ implementation
function tstaticvarsym.mangledname:TSymStr; function tstaticvarsym.mangledname:TSymStr;
{$ifndef jvm}
var var
usename, usename,
prefix : TSymStr; prefix : TSymStr;
{$endif jvm}
begin begin
{$ifdef symansistr} {$ifdef symansistr}
if _mangledname='' then if _mangledname='' then
@ -1915,31 +1881,23 @@ implementation
if not assigned(_mangledname) then if not assigned(_mangledname) then
{$endif symansistr} {$endif symansistr}
begin begin
{$ifdef jvm}
if _mangledbasename='' then
_mangledname:=jvmmangledbasename(self,false)
else
_mangledname:=jvmmangledbasename(self,_mangledbasename,false);
jvmaddtypeownerprefix(owner,_mangledname);
{$else jvm}
if (vo_is_typed_const in varoptions) then if (vo_is_typed_const in varoptions) then
prefix:='TC' prefix:='TC'
else else
prefix:='U'; prefix:='U';
{$ifdef symansistr} {$ifdef symansistr}
if _mangledbasename='' then if _mangledbasename='' then
usename:=name usename:=name
else else
usename:=_mangledbasename; usename:=_mangledbasename;
_mangledname:=make_mangledname(prefix,owner,usename); _mangledname:=make_mangledname(prefix,owner,usename);
{$else symansistr} {$else symansistr}
if not assigned(_mangledbasename) then if not assigned(_mangledbasename) then
usename:=name usename:=name
else else
usename:=_mangledbasename^; usename:=_mangledbasename^;
_mangledname:=stringdup(make_mangledname(prefix,owner,usename)); _mangledname:=stringdup(make_mangledname(prefix,owner,usename));
{$endif symansistr} {$endif symansistr}
{$endif jvm}
end; end;
{$ifdef symansistr} {$ifdef symansistr}
result:=_mangledname; result:=_mangledname;
@ -1978,19 +1936,12 @@ implementation
procedure tstaticvarsym.set_mangledname(const s:TSymStr); procedure tstaticvarsym.set_mangledname(const s:TSymStr);
begin begin
{$ifndef symansistr} {$ifdef symansistr}
stringdispose(_mangledname);
{$endif}
{$if defined(jvm)}
_mangledname:=jvmmangledbasename(self,s,false);
jvmaddtypeownerprefix(owner,_mangledname);
{$else}
{$ifdef symansistr}
_mangledname:=s; _mangledname:=s;
{$else symansistr} {$else symansistr}
stringdispose(_mangledname);
_mangledname:=stringdup(s); _mangledname:=stringdup(s);
{$endif symansistr} {$endif symansistr}
{$endif}
include(varoptions,vo_has_mangledname); include(varoptions,vo_has_mangledname);
end; end;