Browse Source

* split tvisibility from tsymoptions
* replace current_object_option with symtable.currentvisibility

git-svn-id: trunk@12048 -

peter 16 years ago
parent
commit
a3a66ba74d

+ 1 - 1
compiler/dbgbase.pas

@@ -430,7 +430,7 @@ implementation
         for i:=0 to st.SymList.Count-1 do
           begin
             sym:=tsym(st.SymList[i]);
-            if not(sp_hidden in sym.symoptions) and
+            if (sym.visibility<>vis_hidden) and
                (not sym.isdbgwritten) then
               appendsym(list,sym);
           end;

+ 2 - 1
compiler/dbgdwarf.pas

@@ -1873,7 +1873,8 @@ implementation
         fieldoffset,
         fieldnatsize: aint;
       begin
-        if ([sp_static,sp_hidden] * sym.symoptions <> []) then
+        if (sp_static in sym.symoptions) or
+           (sym.visibility=vis_hidden) then
           exit;
 
         if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or

+ 22 - 14
compiler/dbgstabs.pas

@@ -351,19 +351,23 @@ implementation
         newss   : ansistring;
         ss      : pansistring absolute arg;
       begin
-        if (sp_hidden in tsym(p).symoptions) then
+        if (tsym(p).visibility=vis_hidden) then
           exit;
         { static variables from objects are like global objects }
         if (Tsym(p).typ=fieldvarsym) and
            not(sp_static in Tsym(p).symoptions) then
           begin
-            if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-              spec:='/1'
-            else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-              spec:='/0'
-            else
-              spec:='';
-            if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
+           case tsym(p).visibility of
+             vis_private,
+             vis_strictprivate :
+               spec:='/0';
+             vis_protected,
+             vis_strictprotected :
+               spec:='/1';
+             else
+               spec:='';
+           end;
+           if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
               begin
                 varsize:=tfieldvarsym(p).vardef.size;
                 { open arrays made overflows !! }
@@ -447,12 +451,16 @@ implementation
               end;
            { here 2A must be changed for private and protected }
            { 0 is private 1 protected and 2 public }
-           if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-             sp:='0'
-           else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-             sp:='1'
-           else
-             sp:='2';
+           case tsym(p).visibility of
+             vis_private,
+             vis_strictprivate :
+               sp:='0';
+             vis_protected,
+             vis_strictprotected :
+               sp:='1'
+             else
+               sp:='2';
+           end;
            newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd),
                                     def_stab_number(pd.returndef),argnames,sp,
                                     virtualind]);

+ 4 - 4
compiler/ncgrtti.pas

@@ -165,7 +165,7 @@ implementation
         for i:=0 to st.SymList.Count-1 do
           begin
             sym:=tsym(st.SymList[i]);
-            if (sp_published in tsym(sym).symoptions) then
+            if (sym.visibility=vis_published) then
               begin
                 case tsym(sym).typ of
                   propertysym:
@@ -188,7 +188,7 @@ implementation
           begin
             sym:=tsym(st.SymList[i]);
             if (tsym(sym).typ=propertysym) and
-               (sp_published in tsym(sym).symoptions) then
+               (sym.visibility=vis_published) then
               inc(result);
           end;
       end;
@@ -206,7 +206,7 @@ implementation
           begin
             sym:=tsym(objdef.symtable.SymList[i]);
             if (tsym(sym).typ=propertysym) and
-               (sp_published in tsym(sym).symoptions) then
+               (sym.visibility=vis_published) then
               begin
                 pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name));
                 if not assigned(pn) then
@@ -312,7 +312,7 @@ implementation
           begin
             sym:=tsym(st.SymList[i]);
             if (sym.typ=propertysym) and
-               (sp_published in sym.symoptions) then
+               (sym.visibility=vis_published) then
               begin
                 if ppo_indexed in tpropertysym(sym).propoptions then
                   proctypesinfo:=$40

+ 6 - 6
compiler/nobj.pas

@@ -1011,7 +1011,7 @@ implementation
           begin
             pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
             if (pd.procsym=tsym(p)) and
-               (sp_published in pd.symoptions) then
+               (pd.visibility=vis_published) then
               inc(plongint(arg)^);
           end;
       end;
@@ -1029,7 +1029,7 @@ implementation
           begin
             pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
             if (pd.procsym=tsym(p)) and
-               (sp_published in pd.symoptions) then
+               (pd.visibility=vis_published) then
               begin
                 current_asmdata.getdatalabel(l);
 
@@ -1092,8 +1092,8 @@ implementation
         for i:=0 to _class.symtable.SymList.Count-1 do
           begin
             sym:=tsym(_class.symtable.SymList[i]);
-            if (tsym(sym).typ=fieldvarsym) and
-               (sp_published in tsym(sym).symoptions) then
+            if (sym.typ=fieldvarsym) and
+               (sym.visibility=vis_published) then
              begin
                 if tfieldvarsym(sym).vardef.typ<>objectdef then
                   internalerror(200611032);
@@ -1113,8 +1113,8 @@ implementation
         for i:=0 to _class.symtable.SymList.Count-1 do
           begin
             sym:=tsym(_class.symtable.SymList[i]);
-            if (tsym(sym).typ=fieldvarsym) and
-               (sp_published in tsym(sym).symoptions) then
+            if (sym.typ=fieldvarsym) and
+               (sym.visibility=vis_published) then
               begin
                 if (tf_requires_proper_alignment in target_info.flags) then
                   current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(pint)));

+ 15 - 19
compiler/pdecobj.pas

@@ -400,9 +400,9 @@ implementation
         parse_generic:=(df_generic in current_objectdef.defoptions);
         { in "publishable" classes the default access type is published }
         if (oo_can_have_published in current_objectdef.objectoptions) then
-          current_object_option:=[sp_published]
+          current_objectdef.symtable.currentvisibility:=vis_published
         else
-          current_object_option:=[sp_public];
+          current_objectdef.symtable.currentvisibility:=vis_public;
         testcurobject:=1;
         has_destructor:=false;
         object_member_blocktype:=bt_general;
@@ -430,7 +430,7 @@ implementation
                       if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PRIVATE);
-                       current_object_option:=[sp_private];
+                       current_objectdef.symtable.currentvisibility:=vis_private;
                        include(current_objectdef.objectoptions,oo_has_private);
                      end;
                    _PROTECTED :
@@ -438,7 +438,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PROTECTED);
-                       current_object_option:=[sp_protected];
+                       current_objectdef.symtable.currentvisibility:=vis_protected;
                        include(current_objectdef.objectoptions,oo_has_protected);
                      end;
                    _PUBLIC :
@@ -446,7 +446,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLIC);
-                       current_object_option:=[sp_public];
+                       current_objectdef.symtable.currentvisibility:=vis_public;
                      end;
                    _PUBLISHED :
                      begin
@@ -456,7 +456,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLISHED);
-                       current_object_option:=[sp_published];
+                       current_objectdef.symtable.currentvisibility:=vis_published;
                      end;
                    _STRICT :
                      begin
@@ -469,13 +469,13 @@ implementation
                               _PRIVATE:
                                 begin
                                   consume(_PRIVATE);
-                                  current_object_option:=[sp_strictprivate];
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprivate;
                                   include(current_objectdef.objectoptions,oo_has_strictprivate);
                                 end;
                               _PROTECTED:
                                 begin
                                   consume(_PROTECTED);
-                                  current_object_option:=[sp_strictprotected];
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprotected;
                                   include(current_objectdef.objectoptions,oo_has_strictprotected);
                                 end;
                               else
@@ -492,8 +492,8 @@ implementation
                             if is_interface(current_objectdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
-                            if (sp_published in current_object_option) and
-                              not(oo_can_have_published in current_objectdef.objectoptions) then
+                            if (current_objectdef.symtable.currentvisibility=vis_published) and
+                               not(oo_can_have_published in current_objectdef.objectoptions) then
                               Message(parser_e_cant_have_published);
 
                             read_record_fields([vd_object])
@@ -511,7 +511,7 @@ implementation
             _FUNCTION,
             _CLASS :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                    not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
@@ -554,12 +554,11 @@ implementation
               end;
             _CONSTRUCTOR :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                   not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
-                if not(sp_public in current_object_option) and
-                   not(sp_published in current_object_option) then
+                if not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
                   Message(parser_w_constructor_should_be_public);
 
                 if is_interface(current_objectdef) then
@@ -584,7 +583,7 @@ implementation
               end;
             _DESTRUCTOR :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                    not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
@@ -595,7 +594,7 @@ implementation
                 if is_interface(current_objectdef) then
                   Message(parser_e_no_con_des_in_interfaces);
 
-                if not(sp_public in current_object_option) then
+                if (current_objectdef.symtable.currentvisibility<>vis_public) then
                   Message(parser_w_destructor_should_be_public);
 
                 oldparse_only:=parse_only;
@@ -634,10 +633,8 @@ implementation
 
     function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
       var
-        old_object_option : tsymoptions;
         old_current_objectdef : tobjectdef;
       begin
-        old_object_option:=current_object_option;
         old_current_objectdef:=current_objectdef;
 
         current_objectdef:=nil;
@@ -731,7 +728,6 @@ implementation
 
         { restore old state }
         current_objectdef:=old_current_objectdef;
-        current_object_option:=old_object_option;
       end;
 
 end.

+ 2 - 12
compiler/pdecsub.pas

@@ -108,7 +108,6 @@ implementation
              paranr:=paranr_result;
            { Generate result variable accessing function result }
            vs:=tparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
-           vs.symoptions:=[sp_public];
            pd.parast.insert(vs);
            { Store the this symbol as funcretsym for procedures }
            if pd.typ=procdef then
@@ -136,7 +135,6 @@ implementation
             vs:=tparavarsym.create('$parentfp',paranr_parentfp,vs_value
                   ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
             vs.varregable:=vr_none;
-            vs.symoptions:=[sp_public];
             pd.parast.insert(vs);
 
             current_tokenpos:=storepos;
@@ -156,7 +154,6 @@ implementation
           begin
             { Generate self variable }
             vs:=tparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
-            vs.symoptions:=[sp_public];
             pd.parast.insert(vs);
           end
         else
@@ -179,7 +176,6 @@ implementation
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
                    vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,voidpointertype,[vo_is_vmt,vo_is_hidden_para]);
-                   vs.symoptions:=[sp_public];
                    pd.parast.insert(vs);
                  end;
 
@@ -197,7 +193,6 @@ implementation
                     hdef:=tprocdef(pd)._class;
                   end;
                 vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
-                vs.symoptions:=[sp_public];
                 pd.parast.insert(vs);
 
                 current_tokenpos:=storepos;
@@ -282,7 +277,7 @@ implementation
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
                hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
-               hvs.symoptions:=[sp_public];
+               hvs.symoptions:=[];
                owner.insert(hvs);
              end
            else
@@ -382,7 +377,6 @@ implementation
         varspez : Tvarspez;
         defaultvalue : tconstsym;
         defaultrequired : boolean;
-        old_object_option : tsymoptions;
         old_block_type : tblock_type;
         currparast : tparasymtable;
         parseprocvar : tppv;
@@ -391,7 +385,6 @@ implementation
         paranr : integer;
         dummytype : ttypesym;
       begin
-        old_object_option:=current_object_option;
         old_block_type:=block_type;
         explicit_paraloc:=false;
         consume(_LKLAMMER);
@@ -406,8 +399,6 @@ implementation
         sc:=TFPObjectList.create(false);
         defaultrequired:=false;
         paranr:=0;
-        { the variables are always public }
-        current_object_option:=[sp_public];
         inc(testcurobject);
         block_type:=bt_var;
         repeat
@@ -618,7 +609,6 @@ implementation
         sc.free;
         { reset object options }
         dec(testcurobject);
-        current_object_option:=old_object_option;
         block_type:=old_block_type;
         consume(_RKLAMMER);
       end;
@@ -873,7 +863,7 @@ implementation
 
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
-        pd.symoptions:=current_object_option;
+        pd.visibility:=symtablestack.top.currentvisibility;
 
         { parse parameters }
         if token=_LKLAMMER then

+ 22 - 38
compiler/pdecvar.pas

@@ -91,14 +91,14 @@ implementation
                   case sym.typ of
                     fieldvarsym :
                       begin
-                        if not(sp_private in current_object_option) then
+                        if (symtablestack.top.currentvisibility<>vis_private) then
                           addsymref(sym);
                         pl.addsym(sl_load,sym);
                         def:=tfieldvarsym(sym).vardef;
                       end;
                     procsym :
                       begin
-                        if not(sp_private in current_object_option) then
+                        if (symtablestack.top.currentvisibility<>vis_private) then
                           addsymref(sym);
                         pl.addsym(sl_call,sym);
                       end;
@@ -284,12 +284,13 @@ implementation
            end;
          { Generate propertysym and insert in symtablestack }
          p:=tpropertysym.create(orgpattern);
+         p.visibility:=symtablestack.top.currentvisibility;
          symtablestack.top.insert(p);
          consume(_ID);
          { property parameters ? }
          if try_to_consume(_LECKKLAMMER) then
            begin
-              if (sp_published in current_object_option) and
+              if (p.visibility=vis_published) and
                 not (m_delphi in current_settings.modeswitches) then
                 Message(parser_e_cant_publish_that_property);
               { create a list of the parameters }
@@ -414,9 +415,12 @@ implementation
                   message(parser_e_no_property_found_to_override);
                 end;
            end;
-         if ((sp_published in current_object_option) or is_dispinterface(aclass)) and
+         if ((p.visibility=vis_published) or is_dispinterface(aclass)) and
             not(p.propdef.is_publishable) then
-           Message(parser_e_cant_publish_that_property);
+           begin
+             Message(parser_e_cant_publish_that_property);
+             p.visibility:=vis_public;
+           end;
 
          if not(is_dispinterface(aclass)) then
            begin
@@ -1057,13 +1061,9 @@ implementation
          semicoloneaten,
          allowdefaultvalue,
          hasdefaultvalue : boolean;
-         old_current_object_option : tsymoptions;
          hintsymoptions  : tsymoptions;
          old_block_type  : tblock_type;
       begin
-         old_current_object_option:=current_object_option;
-         { all variables are public if not in a object declaration }
-         current_object_option:=[sp_public];
          old_block_type:=block_type;
          block_type:=bt_var;
          { Force an expected ID error message }
@@ -1211,7 +1211,6 @@ implementation
                end;
            end;
          block_type:=old_block_type;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
       end;
@@ -1221,7 +1220,6 @@ implementation
       var
          sc : TFPObjectList;
          i  : longint;
-         old_current_object_option : tsymoptions;
          hs,sorg : string;
          hdef,casetype : tdef;
          { maxsize contains the max. size of a variant }
@@ -1236,6 +1234,7 @@ implementation
          vs    : tabstractvarsym;
          srsym : tsym;
          srsymtable : TSymtable;
+         visibility : tvisibility;
          recst : tabstractrecordsymtable;
          unionsymtable : trecordsymtable;
          offset : longint;
@@ -1251,10 +1250,6 @@ implementation
 {$if defined(powerpc) or defined(powerpc64)}
          is_first_field := true;
 {$endif powerpc or powerpc64}
-         old_current_object_option:=current_object_option;
-         { all variables are public if not in a object declaration }
-         if not(vd_object in options) then
-          current_object_option:=[sp_public];
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
           consume(_ID);
@@ -1264,6 +1259,7 @@ implementation
             not((vd_object in options) and
                 (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
            begin
+             visibility:=symtablestack.top.currentvisibility;
              semicoloneaten:=false;
              sc.clear;
              repeat
@@ -1370,26 +1366,19 @@ implementation
                  consume(_SEMICOLON);
                end;
 
-             if (sp_published in current_object_option) and
+             if (visibility=vis_published) and
                 not(is_class(hdef)) then
                begin
                  Message(parser_e_cant_publish_that);
-                 exclude(current_object_option,sp_published);
-                 { recover by changing access type to public }
-                 for i:=0 to sc.count-1 do
-                   begin
-                     fieldvs:=tfieldvarsym(sc[i]);
-                     exclude(fieldvs.symoptions,sp_published);
-                     include(fieldvs.symoptions,sp_public);
-                   end;
-               end
-             else
-              if (sp_published in current_object_option) and
-                 not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
-                 not(m_delphi in current_settings.modeswitches) then
+                 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);
-                 exclude(current_object_option,sp_published);
+                 visibility:=vis_public;
                end;
 
              { Generate field in the recordsymtable }
@@ -1397,13 +1386,9 @@ implementation
                begin
                  fieldvs:=tfieldvarsym(sc[i]);
                  { static data fields are already inserted in the globalsymtable }
-                 if not(sp_static in current_object_option) then
-                   recst.addfield(fieldvs);
+                 if not(sp_static in fieldvs.symoptions) then
+                   recst.addfield(fieldvs,visibility);
                end;
-
-             { restore current_object_option, it can be changed for
-               publishing or static }
-             current_object_option:=old_current_object_option;
            end;
 
          { Check for Case }
@@ -1429,7 +1414,7 @@ implementation
               if assigned(fieldvs) then
                 begin
                   fieldvs.vardef:=casetype;
-                  recst.addfield(fieldvs);
+                  recst.addfield(fieldvs,recst.currentvisibility);
                 end;
               if not(is_ordinal(casetype))
 {$ifndef cpu64bitaddr}
@@ -1519,7 +1504,6 @@ implementation
               trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               uniondef.owner.deletedef(uniondef);
            end;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
 {$ifdef powerpc}

+ 13 - 7
compiler/psystem.pas

@@ -116,6 +116,12 @@ implementation
           systemunit.insert(result);
         end;
 
+        procedure addfield(recst:tabstractrecordsymtable;sym:tfieldvarsym);
+        begin
+          recst.insert(sym);
+          recst.addfield(sym,vis_hidden);
+        end;
+
         procedure create_fpu_types;
         begin
           if init_settings.fputype<>fpu_none then
@@ -338,26 +344,26 @@ implementation
           type is not available. The rtti for pvmt will be written implicitly
           by thev tblarray below }
         systemunit.insert(ttypesym.create('$pvmt',pvmttype));
-        hrecst.insertfield(tfieldvarsym.create('$length',vs_value,ptrsinttype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$mlength',vs_value,ptrsinttype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$length',vs_value,ptrsinttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$mlength',vs_value,ptrsinttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
         { it seems vmttype is used both for TP objects and Delphi classes,
           so the next entry could either be the first virtual method (vm1)
           (object) or the class name (class). We can't easily create separate
           vtable formats for both, as gdb is hard coded to search for
           __vtbl_ptr_type in all cases (JM) }
-        hrecst.insertfield(tfieldvarsym.create('$vm1_or_classname',vs_value,tpointerdef.create(cshortstringtype),[]));
+        addfield(hrecst,tfieldvarsym.create('$vm1_or_classname',vs_value,tpointerdef.create(cshortstringtype),[]));
         vmtarraytype:=tarraydef.create(0,0,s32inttype);
         tarraydef(vmtarraytype).elementdef:=voidpointertype;
-        hrecst.insertfield(tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
+        addfield(hrecst,tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
         addtype('$__vtbl_ptr_type',vmttype);
         vmtarraytype:=tarraydef.create(0,1,s32inttype);
         tarraydef(vmtarraytype).elementdef:=pvmttype;
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
         hrecst:=trecordsymtable.create(1);
-        hrecst.insertfield(tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
+        addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
+        addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
         methodpointertype:=trecorddef.create(hrecst);
         addtype('$methodpointer',methodpointertype);
         symtablestack.pop(systemunit);

+ 0 - 5
compiler/ptype.pas

@@ -492,10 +492,8 @@ implementation
 
     { reads a record declaration }
     function record_dec : tdef;
-
       var
          recst : trecordsymtable;
-         old_object_option : tsymoptions;
       begin
          { create recdef }
          recst:=trecordsymtable.create(current_settings.packrecords);
@@ -504,11 +502,8 @@ implementation
          symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
-         old_object_option:=current_object_option;
-         current_object_option:=[sp_public];
          read_record_fields([vd_record]);
          consume(_END);
-         current_object_option:=old_object_option;
          { make the record size aligned }
          recst.addalignmentpadding;
          { restore symtable stack }

+ 2 - 0
compiler/symbase.pas

@@ -95,6 +95,7 @@ interface
           defowner  : TDefEntry; { for records and objects }
           moduleid  : longint;
           refcount  : smallint;
+          currentvisibility : tvisibility;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtabletype  : TSymtabletype;
@@ -220,6 +221,7 @@ implementation
          DefList:=TFPObjectList.Create(true);
          SymList:=TFPHashObjectList.Create(true);
          refcount:=1;
+         currentvisibility:=vis_public;
       end;
 
 

+ 16 - 7
compiler/symconst.pas

@@ -122,12 +122,19 @@ type
     deref_defid
   );
 
+  { symbol visibility }
+  tvisibility=(
+    vis_hidden,
+    vis_strictprivate,
+    vis_private,
+    vis_strictprotected,
+    vis_protected,
+    vis_public,
+    vis_published
+  );
+
   { symbol options }
   tsymoption=(sp_none,
-    sp_public,
-    sp_private,
-    sp_published,
-    sp_protected,
     sp_static,
     sp_hint_deprecated,
     sp_hint_platform,
@@ -135,10 +142,7 @@ type
     sp_hint_unimplemented,
     sp_has_overloaded,
     sp_internal,  { internal symbol, not reported as unused }
-    sp_strictprivate,
-    sp_strictprotected,
     sp_implicitrename,
-    sp_hidden,
     sp_hint_experimental,
     sp_generic_para
   );
@@ -506,6 +510,11 @@ const
        'convert_l1','equal','exact'
      );
 
+     visibilityName : array[tvisibility] of string[16] = (
+       'hidden','strict private','private','strict protected','protected',
+       'public','published'
+     );
+
 implementation
 
 end.

+ 12 - 13
compiler/symdef.pas

@@ -427,6 +427,7 @@ interface
             EXTDEBUG has fileinfo in tdef (PFV) }
           fileinfo : tfileposinfo;
 {$endif}
+          visibility : tvisibility;
           symoptions : tsymoptions;
           { symbol owning this definition }
           procsym : tsym;
@@ -561,8 +562,6 @@ interface
           function  is_publishable : boolean;override;
        end;
 
-       Tdefmatch=(dm_exact,dm_equal,dm_convertl1);
-
     var
        current_objectdef : tobjectdef;  { used for private functions check !! }
 
@@ -2779,19 +2778,17 @@ implementation
                  s:=s+'<';
                case hp.varspez of
                  vs_var :
-                   s:=s+'var';
+                   s:=s+'var ';
                  vs_const :
-                   s:=s+'const';
+                   s:=s+'const ';
                  vs_out :
-                   s:=s+'out';
+                   s:=s+'out ';
                end;
                if assigned(hp.vardef.typesym) then
                  begin
-                   if s<>'(' then
-                    s:=s+' ';
                    hs:=hp.vardef.typesym.realname;
                    if hs[1]<>'$' then
-                     s:=s+hp.vardef.typesym.realname
+                     s:=s+hs
                    else
                      s:=s+hp.vardef.GetTypeName;
                  end
@@ -2902,6 +2899,7 @@ implementation
          ppufile.getderef(_classderef);
          ppufile.getderef(procsymderef);
          ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
@@ -3038,6 +3036,7 @@ implementation
          ppufile.putderef(_classderef);
          ppufile.putderef(procsymderef);
          ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
@@ -3192,18 +3191,18 @@ implementation
 
         { private symbols are allowed when we are in the same
           module as they are defined }
-        if (sp_private in symoptions) and
+        if (visibility=vis_private) and
            (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
            not(owner.defowner.owner.iscurrentunit or (owner.defowner.owner=contextst)) then
           exit;
 
-        if (sp_strictprivate in symoptions) then
+        if (visibility=vis_strictprivate) then
           begin
             result:=currobjdef=tobjectdef(owner.defowner);
             exit;
           end;
 
-        if (sp_strictprotected in symoptions) then
+        if (visibility=vis_strictprotected) then
           begin
              result:=assigned(currobjdef) and
                currobjdef.is_related(tobjectdef(owner.defowner));
@@ -3213,7 +3212,7 @@ implementation
         { protected symbols are visible in the module that defines them and
           also visible to related objects. The related object must be defined
           in the current module }
-        if (sp_protected in symoptions) and
+        if (visibility=vis_protected) and
            (
             (
              (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
@@ -4010,7 +4009,7 @@ implementation
              vs:=tfieldvarsym.create('_vptr$'+objname^,vs_value,voidpointertype,[]);
              hidesym(vs);
              tObjectSymtable(symtable).insert(vs);
-             tObjectSymtable(symtable).addfield(vs);
+             tObjectSymtable(symtable).addfield(vs,vis_hidden);
              include(objectoptions,oo_has_vmt);
           end;
      end;

+ 3 - 1
compiler/symsym.pas

@@ -363,6 +363,7 @@ implementation
          { Register symbol }
          current_module.symlist[SymId]:=self;
          ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
       end;
 
@@ -372,6 +373,7 @@ implementation
          ppufile.putlongint(SymId);
          ppufile.putstring(realname);
          ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
       end;
 
@@ -470,7 +472,7 @@ implementation
          FProcdefderefList:=nil;
          { the tprocdef have their own symoptions, make the procsym
            always visible }
-         symoptions:=[sp_public];
+         visibility:=vis_public;
          overloadchecked:=false;
       end;
 

+ 14 - 20
compiler/symtable.pas

@@ -88,8 +88,7 @@ interface
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure alignrecord(fieldoffset:aint;varalign:shortint);
-          procedure addfield(sym:tfieldvarsym);
-          procedure insertfield(sym:tfieldvarsym);
+          procedure addfield(sym:tfieldvarsym;vis:tvisibility);
           procedure addalignmentpadding;
           procedure insertdef(def:TDefEntry);override;
           function is_packed: boolean;
@@ -636,7 +635,7 @@ implementation
 
     procedure TStoredSymtable.TestPrivate(sym:TObject;arg:pointer);
       begin
-        if sp_private in tsym(sym).symoptions then
+        if tsym(sym).visibility=vis_private then
           varsymbolused(sym,arg);
       end;
 
@@ -660,6 +659,14 @@ implementation
       end;
 
 
+   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
+     begin
+        if (tsym(sym).typ=propertysym) and
+           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
+          ppointer(arg)^:=sym;
+     end;
+
+
 {***********************************************
            Process all entries
 ***********************************************}
@@ -815,7 +822,7 @@ implementation
         recordalignment:=max(recordalignment,varalignrecord);
       end;
 
-    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym);
+    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
       var
         l      : aint;
         varalignfield,
@@ -826,6 +833,8 @@ implementation
           internalerror(200602031);
         if sym.fieldoffset<>-1 then
           internalerror(200602032);
+        { set visibility for the symbol }
+        sym.visibility:=vis;
         { this symbol can't be loaded to a register }
         sym.varregable:=vr_none;
         { Calculate field offset }
@@ -914,13 +923,6 @@ implementation
       end;
 
 
-    procedure tabstractrecordsymtable.insertfield(sym:tfieldvarsym);
-      begin
-        insert(sym);
-        addfield(sym);
-      end;
-
-
     procedure tabstractrecordsymtable.addalignmentpadding;
       begin
         { make the record size aligned correctly so it can be
@@ -1503,7 +1505,7 @@ implementation
     procedure hidesym(sym:TSymEntry);
       begin
         sym.realname:='$hidden'+sym.realname;
-        include(tsym(sym).symoptions,sp_hidden);
+        tsym(sym).visibility:=vis_hidden;
       end;
 
 
@@ -1952,14 +1954,6 @@ implementation
       end;
 
 
-   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
-     begin
-        if (tsym(sym).typ=propertysym) and
-           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
-          ppointer(arg)^:=sym;
-     end;
-
-
    function search_default_property(pd : tobjectdef) : tpropertysym;
    { returns the default property of a class, searches also anchestors }
      var

+ 6 - 8
compiler/symtype.pas

@@ -97,6 +97,7 @@ interface
       public
          fileinfo   : tfileposinfo;
          symoptions : tsymoptions;
+         visibility : tvisibility;
          refs       : longint;
          reflist    : TLinkedList;
          isdbgwritten : boolean;
@@ -195,9 +196,6 @@ interface
       memprocnodetree : tmemdebug;
 {$endif MEMDEBUG}
 
-    const
-       current_object_option : tsymoptions = [sp_public];
-
     function  FindUnitSymtable(st:TSymtable):TSymtable;
 
 
@@ -334,7 +332,7 @@ implementation
          symoptions:=[];
          fileinfo:=current_tokenpos;
          isdbgwritten := false;
-         symoptions:=current_object_option;
+         visibility:=vis_public;
       end;
 
     destructor  Tsym.destroy;
@@ -396,20 +394,20 @@ implementation
 
         { private symbols are allowed when we are in the same
           module as they are defined }
-        if (sp_private in symoptions) and
+        if (visibility=vis_private) and
            assigned(owner.defowner) and
            (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
            (not owner.defowner.owner.iscurrentunit) then
           exit;
 
-        if (sp_strictprivate in symoptions) then
+        if (visibility=vis_strictprivate) then
           begin
             result:=assigned(currobjdef) and
               (context=tdef(owner.defowner));
             exit;
           end;
 
-        if (sp_strictprotected in symoptions) then
+        if (visibility=vis_strictprotected) then
           begin
             result:=assigned(context) and
               context.is_related(tdef(owner.defowner));
@@ -418,7 +416,7 @@ implementation
 
         { protected symbols are visible in the module that defines them and
           also visible to related objects }
-        if (sp_protected in symoptions) and
+        if (visibility=vis_protected) and
            (
             (
              assigned(owner.defowner) and

+ 34 - 19
compiler/utils/ppudump.pp

@@ -171,10 +171,10 @@ type
         target_arm_symbian,        { 60 }
         target_x86_64_darwin,      { 61 }
         target_avr_embedded,       { 62 }
-        target_i386_haiku          { 63 }             
+        target_i386_haiku          { 63 }
   );
 const
-  Targets : array[ttarget] of string[17]=(
+  Targets : array[ttarget] of string[18]=(
   { 0 }   'none',
   { 1 }   'GO32V1 (obsolete)',
   { 2 }   'GO32V2',
@@ -238,7 +238,7 @@ const
   { 60 }  'Symbian-arm',
   { 61 }  'MacOSX-x64',
   { 62 }  'Embedded-avr',
-  { 63 }  'Haiku-i386'        
+  { 63 }  'Haiku-i386'
   );
 begin
   if w<=ord(high(ttarget)) then
@@ -281,6 +281,20 @@ begin
 end;
 
 
+Function Visibility2Str(w:longint):string;
+const
+  visibilitystr : array[0..6] of string[16]=(
+    'hidden','strict private','private','strict protected','protected',
+    'public','published'
+  );
+begin
+  if w<=ord(high(visibilitystr)) then
+    result:=visibilitystr[w]
+  else
+    result:='<!! Unknown visibility value '+tostr(w)+'>';
+end;
+
+
 function PPUFlags2Str(flags:longint):string;
 type
   tflagopt=record
@@ -703,18 +717,18 @@ end;
 
 procedure readsymoptions;
 type
+  { symbol options }
   tsymoption=(sp_none,
-    sp_public,
-    sp_private,
-    sp_published,
-    sp_protected,
     sp_static,
     sp_hint_deprecated,
     sp_hint_platform,
     sp_hint_library,
     sp_hint_unimplemented,
+    sp_hint_experimental,
     sp_has_overloaded,
-    sp_internal  { internal symbol, not reported as unused }
+    sp_internal,  { internal symbol, not reported as unused }
+    sp_implicitrename,
+    sp_generic_para
   );
   tsymoptions=set of tsymoption;
   tsymopt=record
@@ -722,19 +736,18 @@ type
     str  : string[30];
   end;
 const
-  symopts=11;
+  symopts=10;
   symopt : array[1..symopts] of tsymopt=(
-     (mask:sp_public;         str:'Public'),
-     (mask:sp_private;        str:'Private'),
-     (mask:sp_published;      str:'Published'),
-     (mask:sp_protected;      str:'Protected'),
      (mask:sp_static;         str:'Static'),
      (mask:sp_hint_deprecated;str:'Hint Deprecated'),
-     (mask:sp_hint_deprecated;str:'Hint Platform'),
-     (mask:sp_hint_deprecated;str:'Hint Library'),
-     (mask:sp_hint_deprecated;str:'Hint Unimplemented'),
+     (mask:sp_hint_platform;  str:'Hint Platform'),
+     (mask:sp_hint_library;   str:'Hint Library'),
+     (mask:sp_hint_unimplemented;str:'Hint Unimplemented'),
+     (mask:sp_hint_experimental;str:'Hint Experimental'),
      (mask:sp_has_overloaded; str:'Has overloaded'),
-     (mask:sp_internal;       str:'Internal')
+     (mask:sp_internal;       str:'Internal'),
+     (mask:sp_implicitrename; str:'Implicit Rename'),
+     (mask:sp_generic_para;   str:'Generic Parameter')
   );
 var
   symoptions : tsymoptions;
@@ -763,9 +776,10 @@ procedure readcommonsym(const s:string);
 begin
   writeln(space,'** Symbol Id ',ppufile.getlongint,' **');
   writeln(space,s,ppufile.getstring);
-  write(space,'     File Pos : ');
+  write  (space,'     File Pos : ');
   readposinfo;
-  write(space,'   SymOptions : ');
+  writeln(space,'   Visibility : ',Visibility2Str(ppufile.getbyte));
+  write  (space,'   SymOptions : ');
   readsymoptions;
 end;
 
@@ -1793,6 +1807,7 @@ begin
              readderef;
              write  (space,'         File Pos : ');
              readposinfo;
+             writeln(space,'       Visibility : ',Visibility2Str(ppufile.getbyte));
              write  (space,'       SymOptions : ');
              readsymoptions;
              if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then