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

* extracted the code to deal with static fields into a routine

Browse Source 
(make_field_static() ) and replaced semi-duplicates of that
    code with calls to this routine
  * made the handling of static fields for the JVM target more
    similar to that on the other targets, so that class properties
    now also work there (-> updated JVM-specific code in several
    places to deal with this new handling)

git-svn-id: branches/jvmbackend@18723 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:27:48 +00:00
parent 1c74072748
commit b3072b3dab
8 changed files with 109 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
compiler/agjasmin.pas
View File

@ -809,30 +809,11 @@ implementation
function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): ansistring;
var
vissym: tabstractvarsym;
begin
vissym:=sym;
{ static field definition -> get original field definition for
visibility }
if (sym.typ=staticvarsym) and
(sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
begin
vissym:=tabstractvarsym(
tabstractrecorddef(sym.owner.defowner).symtable.find(
internal_static_field_name(sym.name)));
if not assigned(vissym) then
vissym:=tabstractvarsym(
tabstractrecorddef(sym.owner.defowner).symtable.find(
generate_nested_name(sym.owner,'_')+'_'+sym.name));
if not assigned(vissym) or
not(vissym.typ in [fieldvarsym,absolutevarsym]) then
internalerror(2011011501);
end;
case vissym.typ of
case sym.typ of
staticvarsym:
begin
if vissym.owner.symtabletype=globalsymtable then
if sym.owner.symtabletype=globalsymtable then
result:='public '
else
{ package visbility }
@ -840,7 +821,7 @@ implementation
end;
fieldvarsym,
absolutevarsym:
result:=VisibilityToStr(tstoredsym(vissym).visibility);
result:=VisibilityToStr(tstoredsym(sym).visibility);
else
internalerror(2011011204);
end;
@ -933,7 +914,8 @@ implementation
procedure TJasminAssembler.WriteFieldSym(sym: tabstractvarsym);
begin
{ internal static field definition alias -> skip }
if sp_static in sym.symoptions then
if (sym.owner.symtabletype in [recordsymtable,ObjectSymtable]) and
(sym.typ=staticvarsym) then
exit;
{ external definition -> no definition here }
if vo_is_external in sym.varoptions then

2
compiler/jvm/hlcgcpu.pas
View File

@ -1935,7 +1935,7 @@ implementation
if (tsym(st.symlist[i]).typ<>allocvartyp) then
continue;
vs:=tabstractvarsym(st.symlist[i]);
if sp_internal in vs.symoptions then
if sp_static in vs.symoptions then
continue;
{ vo_is_external and vo_has_local_copy means a staticvarsym that is
alias for a constsym, whose sole purpose is for allocating and

5
compiler/jvm/njvmcnv.pas
View File

@ -422,10 +422,9 @@ implementation
begin
{ get the class representing the primitive type }
fvs:=search_struct_member(tobjectdef(corrclass),'FTYPE');
if not assigned(fvs) or
(fvs.typ<>staticvarsym) then
newpara:=nil;
if not handle_staticfield_access(fvs,false,newpara) then
internalerror(2011072417);
newpara:=cloadnode.create(fvs,fvs.owner);
end
else
newpara:=cloadvmtaddrnode.create(ctypenode.create(corrclass));

10
compiler/jvm/njvmcon.pas
View File

@ -87,7 +87,7 @@ implementation
cutils,widestr,verbose,constexp,fmodule,
symdef,symsym,symtable,symconst,
aasmdata,aasmcpu,defutil,
ncnv,nld,nmem,pjvm,pass_1,
nutils,ncnv,nld,nmem,pjvm,pass_1,
cgbase,hlcgobj,hlcgcpu,cgutils,cpubase
;
@ -128,11 +128,11 @@ implementation
end;
{ b) find the corresponding class field }
classfield:=search_struct_member(basedef.classdef,sym.name);
if not assigned(classfield) or
(classfield.typ<>staticvarsym) then
internalerror(2011062606);
{ c) create loadnode of the field }
result:=cloadnode.create(classfield,classfield.owner);
result:=nil;
if not handle_staticfield_access(classfield,false,result) then
internalerror(2011062606);
end;

24
compiler/pdecl.pas
View File

@ -63,7 +63,7 @@ implementation
{ aasm }
aasmbase,aasmtai,aasmdata,fmodule,
{ symtable }
symconst,symbase,symtype,symtable,paramgr,defutil,
symconst,symbase,symtype,symtable,symcreat,paramgr,defutil,
{ pass 1 }
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
{ codegen }
@ -174,7 +174,7 @@ implementation
var
orgname : TIDString;
hdef : tdef;
sym, tmp : tsym;
sym : tsym;
dummysymoptions : tsymoptions;
deprecatedmsg : pshortstring;
storetokenpos,filepos : tfileposinfo;
@ -182,8 +182,6 @@ implementation
skipequal : boolean;
tclist : tasmlist;
varspez : tvarspez;
static_name : string;
sl : tpropaccesslist;
begin
old_block_type:=block_type;
block_type:=bt_const;
@ -247,23 +245,9 @@ implementation
to it from the structure or linking will fail }
if symtablestack.top.symtabletype in [recordsymtable,ObjectSymtable] then
begin
{ generate the symbol which reserves the space }
static_name:=lower(generate_nested_name(symtablestack.top,'_'))+'_'+orgname;
{$ifndef jvm}
sym:=tstaticvarsym.create(internal_static_field_name(static_name),varspez,hdef,[]);
include(sym.symoptions,sp_internal);
tabstractrecordsymtable(symtablestack.top).get_unit_symtable.insert(sym);
{$else not jvm}
sym:=tstaticvarsym.create(orgname,varspez,hdef,[]);
sym:=tfieldvarsym.create(orgname,varspez,hdef,[]);
symtablestack.top.insert(sym);
orgname:=static_name;
{$endif not jvm}
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,sym);
tmp:=tabsolutevarsym.create_ref(orgname,hdef,sl);
tmp.visibility:=symtablestack.top.currentvisibility;
symtablestack.top.insert(tmp);
sym:=make_field_static(symtablestack.top,tfieldvarsym(sym));
end
else
begin

78
compiler/pdecvar.pas
View File

@ -27,7 +27,7 @@ unit pdecvar;
interface
uses
symsym,symdef;
symtable,symsym,symdef;
type
tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final);
@ -53,7 +53,7 @@ implementation
globtype,globals,tokens,verbose,constexp,
systems,
{ symtable }
symconst,symbase,symtype,symtable,defutil,defcmp,symcreat,
symconst,symbase,symtype,defutil,defcmp,symcreat,
{$ifdef jvm}
jvmdef,
{$endif}
@ -1538,7 +1538,7 @@ implementation
var
sc : TFPObjectList;
i : longint;
hs,sorg,static_name : string;
hs,sorg : string;
hdef,casetype : tdef;
{ maxsize contains the max. size of a variant }
{ startvarrec contains the start of the variant part of a record }
@ -1565,7 +1565,6 @@ implementation
tempdef: tdef;
is_first_type: boolean;
{$endif powerpc or powerpc64}
sl: tpropaccesslist;
old_block_type: tblock_type;
begin
old_block_type:=block_type;
@ -1725,56 +1724,6 @@ implementation
(oo_is_external in tobjectdef(recst.defowner).objectoptions) then
try_read_field_external_sc(sc);
end;
if vd_class in options then
begin
{ add static flag and staticvarsyms }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
include(fieldvs.symoptions,sp_static);
{ generate the symbol which reserves the space }
static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
{$ifndef jvm}
hstaticvs:=tstaticvarsym.create(internal_static_field_name(static_name),vs_value,hdef,[]);
include(hstaticvs.symoptions,sp_internal);
recst.get_unit_symtable.insert(hstaticvs);
cnodeutils.insertbssdata(hstaticvs);
{$else not jvm}
{ for the JVM, static field accesses are name-based and
hence we have to keep the original name of the field.
Create a staticvarsym instead of a fieldvarsym so we can
nevertheless use a loadn instead of a subscriptn though,
since a subscriptn requires something to subscript and
there is nothing in this case (class+field name will be
encoded in the mangled symbol name) }
hstaticvs:=tstaticvarsym.create(fieldvs.realname,vs_value,hdef,[]);
{ rename the original field to prevent a name clash when
inserting the new one }
fieldvs.Rename(internal_static_field_name(fieldvs.name));
include(fieldvs.symoptions,sp_internal);
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;
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,hstaticvs);
recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
end;
end;
if vd_final in options then
begin
{ add final flag }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
fieldvs.varspez:=vs_final;
end;
end;
if (visibility=vis_published) and
not(is_class(hdef)) then
begin
@ -1789,6 +1738,27 @@ implementation
Message(parser_e_only_publishable_classes_can_be_published);
visibility:=vis_public;
end;
if vd_class in options then
begin
{ add static flag and staticvarsyms }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
fieldvs.visibility:=visibility;
hstaticvs:=make_field_static(recst,fieldvs);
if vd_final in options then
hstaticvs.varspez:=vs_final;
end;
end;
if vd_final in options then
begin
{ add final flag }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
fieldvs.varspez:=vs_final;
end;
end;
{ Generate field in the recordsymtable }
for i:=0 to sc.count-1 do

29
compiler/pjvm.pas
View File

@ -323,12 +323,9 @@ implementation
{ create static fields representing all enums }
for i:=0 to tenumdef(def).symtable.symlist.count-1 do
begin
sym:=tstaticvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
enumclass.symtable.insert(sym);
{ alias for consistency with parsed staticvarsyms }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,sym);
enumclass.symtable.insert(tabsolutevarsym.create_ref('$'+internal_static_field_name(sym.name),enumclass,sl));
fsym:=tfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
enumclass.symtable.insert(fsym);
sym:=make_field_static(enumclass.symtable,fsym);
end;
{ create local "array of enumtype" type for the "values" functionality
(used internally by the JDK) }
@ -353,12 +350,9 @@ implementation
tobjectsymtable(enumclass.symtable).addfield(fsym,vis_strictprivate);
{ add class field with hash table that maps from FPC-declared ordinal value -> enum instance }
juhashmap:=search_system_type('JUHASHMAP').typedef;
sym:=tstaticvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[]);
enumclass.symtable.insert(sym);
{ alias for consistency with parsed staticvarsyms }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,sym);
enumclass.symtable.insert(tabsolutevarsym.create_ref('$'+internal_static_field_name(sym.name),enumclass,sl));
fsym:=tfieldvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[]);
enumclass.symtable.insert(fsym);
make_field_static(enumclass.symtable,fsym);
{ add custom constructor }
if not str_parse_method_dec('constructor Create(const __fpc_name: JLString; const __fpc_ord, __fpc_initenumval: longint);',potype_constructor,false,enumclass,pd) then
internalerror(2011062401);
@ -413,13 +407,10 @@ implementation
"Values" instance method -- that's also the reason why we insert the
field only now, because we cannot disable duplicate identifier
checking when creating the "Values" method }
sym:=tstaticvarsym.create('$VALUES',vs_final,arrdef,[]);
sym.visibility:=vis_strictprivate;
enumclass.symtable.insert(sym,false);
{ alias for consistency with parsed staticvarsyms }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,sym);
enumclass.symtable.insert(tabsolutevarsym.create_ref('$'+internal_static_field_name(sym.name),arrdef,sl));
fsym:=tfieldvarsym.create('$VALUES',vs_final,arrdef,[]);
fsym.visibility:=vis_strictprivate;
enumclass.symtable.insert(fsym,false);
sym:=make_field_static(enumclass.symtable,fsym);
{ alias for accessing the field in generated Pascal code }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,sym);

66
compiler/symcreat.pas
View File

@ -108,6 +108,11 @@ interface
procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
{ turns a fieldvarsym into a class/static field definition, and returns the
created staticvarsym that is responsible for allocating the global storage }
function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
implementation
uses
@ -117,7 +122,7 @@ implementation
{$ifdef jvm}
pjvm,jvmdef,
{$endif jvm}
node,nbas,nld,nmem,
node,nbas,nld,nmem,ngenutil,
defcmp,
paramgr;
@ -557,10 +562,10 @@ implementation
var
enumclass: tobjectdef;
enumdef: tenumdef;
enumname,
str: ansistring;
i: longint;
enumsym: tenumsym;
classfield: tstaticvarsym;
orderedenums: tfpobjectlist;
begin
enumclass:=tobjectdef(pd.owner.defowner);
@ -587,18 +592,16 @@ implementation
for i:=0 to orderedenums.count-1 do
begin
enumsym:=tenumsym(orderedenums[i]);
classfield:=tstaticvarsym(search_struct_member(enumclass,enumsym.name));
if not assigned(classfield) then
internalerror(2011062306);
str:=str+classfield.name+':=__FPC_TEnumClassAlias.Create('''+enumsym.realname+''','+tostr(i);
enumname:=enumsym.realname;
str:=str+enumsym.name+':=__FPC_TEnumClassAlias.Create('''+enumname+''','+tostr(i);
if enumdef.has_jumps then
str:=str+','+tostr(enumsym.value);
str:=str+');';
{ alias for $VALUES array used internally by the JDK, and also by FPC
in case of no jumps }
str:=str+'__fpc_FVALUES['+tostr(i)+']:='+classfield.name+';';
str:=str+'__fpc_FVALUES['+tostr(i)+']:='+enumname+';';
if enumdef.has_jumps then
str:=str+'__fpc_ord2enum.put(JLInteger.valueOf('+tostr(enumsym.value)+'),'+classfield.name+');';
str:=str+'__fpc_ord2enum.put(JLInteger.valueOf('+tostr(enumsym.value)+'),'+enumname+');';
end;
orderedenums.free;
str:=str+' end;';
@ -1102,5 +1105,52 @@ implementation
end;
function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
var
static_name: string;
hstaticvs: tstaticvarsym;
tmp: tabsolutevarsym;
sl: tpropaccesslist;
begin
include(fieldvs.symoptions,sp_static);
{ generate the symbol which reserves the space }
static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
hstaticvs:=tstaticvarsym.create(internal_static_field_name(static_name),vs_value,fieldvs.vardef,[]);
{$ifdef jvm}
{ for the JVM, static field accesses are name-based and
hence we have to keep the original name of the field.
Create a staticvarsym instead of a fieldvarsym so we can
nevertheless use a loadn instead of a subscriptn though,
since a subscriptn requires something to subscript and
there is nothing in this case (class+field name will be
encoded in the mangled symbol 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^)
else
hstaticvs.set_mangledname(fieldvs.realname);
{ for definition in class file }
hstaticvs.visibility:=fieldvs.visibility;
{$else jvm}
include(hstaticvs.symoptions,sp_internal);
tabstractrecordsymtable(recst).get_unit_symtable.insert(hstaticvs);
cnodeutils.insertbssdata(hstaticvs);
{$endif jvm}
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,hstaticvs);
{ do *not* change the visibility of this absolutevarsym from vis_public
to anything else, because its visibility is used by visibility checks
after turning a class property referring to a class variable into a
load node (handle_staticfield_access -> searchsym_in_class ->
is_visible_for_object), which means that the load will fail if this
symbol is e.g. "strict private" while the property is public }
tmp:=tabsolutevarsym.create_ref('$'+static_name,fieldvs.vardef,sl);
recst.insert(tmp);
result:=hstaticvs;
end;
end.