ソースを参照

* extracted the code to deal with static fields into a routine
(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 -

Jonas Maebe 14 年 前
コミット
b3072b3dab

+ 5 - 23
compiler/agjasmin.pas

@@ -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

+ 1 - 1
compiler/jvm/hlcgcpu.pas

@@ -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

+ 2 - 3
compiler/jvm/njvmcnv.pas

@@ -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));

+ 5 - 5
compiler/jvm/njvmcon.pas

@@ -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;
 
 

+ 4 - 20
compiler/pdecl.pas

@@ -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

+ 19 - 49
compiler/pdecvar.pas

@@ -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,45 +1724,30 @@ implementation
                     (oo_is_external in tobjectdef(recst.defowner).objectoptions) then
                    try_read_field_external_sc(sc);
                end;
+             if (visibility=vis_published) and
+                not(is_class(hdef)) then
+               begin
+                 Message(parser_e_cant_publish_that);
+                 visibility:=vis_public;
+               end;
+
+             if (visibility=vis_published) and
+                not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
+                not(m_delphi in current_settings.modeswitches) then
+               begin
+                 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]);
-                     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}
+                     fieldvs.visibility:=visibility;
+                     hstaticvs:=make_field_static(recst,fieldvs);
                      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
@@ -1775,20 +1759,6 @@ implementation
                      fieldvs.varspez:=vs_final;
                    end;
                end;
-             if (visibility=vis_published) and
-                not(is_class(hdef)) then
-               begin
-                 Message(parser_e_cant_publish_that);
-                 visibility:=vis_public;
-               end;
-
-             if (visibility=vis_published) and
-                not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
-                not(m_delphi in current_settings.modeswitches) then
-               begin
-                 Message(parser_e_only_publishable_classes_can_be_published);
-                 visibility:=vis_public;
-               end;
 
              { Generate field in the recordsymtable }
              for i:=0 to sc.count-1 do

+ 10 - 19
compiler/pjvm.pas

@@ -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);

+ 58 - 8
compiler/symcreat.pas

@@ -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.