paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 15:47:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

* split tvisibility from tsymoptions

Browse Source 
* replace current_object_option with symtable.currentvisibility

git-svn-id: trunk@12048 -
This commit is contained in:
peter 2008-11-11 09:05:39 +00:00
parent e5e3462161
commit a3a66ba74d
17 changed files with 174 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/dbgbase.pas
View File

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

3
compiler/dbgdwarf.pas
View File

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

36
compiler/dbgstabs.pas
View File

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

8
compiler/ncgrtti.pas
View File

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

12
compiler/nobj.pas
View File

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

34
compiler/pdecobj.pas
View File

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

14
compiler/pdecsub.pas
View File

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

60
compiler/pdecvar.pas
View File

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

20
compiler/psystem.pas
View File

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

5
compiler/ptype.pas
View File

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

2
compiler/symbase.pas
View File

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

23
compiler/symconst.pas
View File

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

25
compiler/symdef.pas
View File

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

4
compiler/symsym.pas
View File

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

34
compiler/symtable.pas
View File

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

14
compiler/symtype.pas
View File

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

53
compiler/utils/ppudump.pp
View File

@ -171,10 +171,10 @@ type
target_arm_symbian, { 60 } target_arm_symbian, { 60 }
target_x86_64_darwin, { 61 } target_x86_64_darwin, { 61 }
target_avr_embedded, { 62 } target_avr_embedded, { 62 }
target_i386_haiku { 63 } target_i386_haiku { 63 }
); );
const const
Targets : array[ttarget] of string[17]=( Targets : array[ttarget] of string[18]=(
{ 0 } 'none', { 0 } 'none',
{ 1 } 'GO32V1 (obsolete)', { 1 } 'GO32V1 (obsolete)',
{ 2 } 'GO32V2', { 2 } 'GO32V2',
@ -238,7 +238,7 @@ const
{ 60 } 'Symbian-arm', { 60 } 'Symbian-arm',
{ 61 } 'MacOSX-x64', { 61 } 'MacOSX-x64',
{ 62 } 'Embedded-avr', { 62 } 'Embedded-avr',
{ 63 } 'Haiku-i386' { 63 } 'Haiku-i386'
); );
begin begin
if w<=ord(high(ttarget)) then if w<=ord(high(ttarget)) then
@ -281,6 +281,20 @@ begin
end; 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; function PPUFlags2Str(flags:longint):string;
type type
tflagopt=record tflagopt=record
@ -703,18 +717,18 @@ end;
procedure readsymoptions; procedure readsymoptions;
type type
{ symbol options }
tsymoption=(sp_none, tsymoption=(sp_none,
sp_public,
sp_private,
sp_published,
sp_protected,
sp_static, sp_static,
sp_hint_deprecated, sp_hint_deprecated,
sp_hint_platform, sp_hint_platform,
sp_hint_library, sp_hint_library,
sp_hint_unimplemented, sp_hint_unimplemented,
sp_hint_experimental,
sp_has_overloaded, 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; tsymoptions=set of tsymoption;
tsymopt=record tsymopt=record
@ -722,19 +736,18 @@ type
str : string[30]; str : string[30];
end; end;
const const
symopts=11; symopts=10;
symopt : array[1..symopts] of tsymopt=( 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_static; str:'Static'),
(mask:sp_hint_deprecated;str:'Hint Deprecated'), (mask:sp_hint_deprecated;str:'Hint Deprecated'),
(mask:sp_hint_deprecated;str:'Hint Platform'), (mask:sp_hint_platform; str:'Hint Platform'),
(mask:sp_hint_deprecated;str:'Hint Library'), (mask:sp_hint_library; str:'Hint Library'),
(mask:sp_hint_deprecated;str:'Hint Unimplemented'), (mask:sp_hint_unimplemented;str:'Hint Unimplemented'),
(mask:sp_hint_experimental;str:'Hint Experimental'),
(mask:sp_has_overloaded; str:'Has overloaded'), (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 var
symoptions : tsymoptions; symoptions : tsymoptions;
@ -763,9 +776,10 @@ procedure readcommonsym(const s:string);
begin begin
writeln(space,'** Symbol Id ',ppufile.getlongint,' **'); writeln(space,'** Symbol Id ',ppufile.getlongint,' **');
writeln(space,s,ppufile.getstring); writeln(space,s,ppufile.getstring);
write(space,' File Pos : '); write (space,' File Pos : ');
readposinfo; readposinfo;
write(space,' SymOptions : '); writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte));
write (space,' SymOptions : ');
readsymoptions; readsymoptions;
end; end;
@ -1793,6 +1807,7 @@ begin
readderef; readderef;
write (space,' File Pos : '); write (space,' File Pos : ');
readposinfo; readposinfo;
writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte));
write (space,' SymOptions : '); write (space,' SymOptions : ');
readsymoptions; readsymoptions;
if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then