paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +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
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;

3
compiler/dbgdwarf.pas
View File

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

36
compiler/dbgstabs.pas
View File

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

8
compiler/ncgrtti.pas
View File

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

12
compiler/nobj.pas
View File

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

34
compiler/pdecobj.pas
View File

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

14
compiler/pdecsub.pas
View File

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

60
compiler/pdecvar.pas
View File

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

20
compiler/psystem.pas
View File

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

5
compiler/ptype.pas
View File

@ -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
compiler/symbase.pas
View File

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

23
compiler/symconst.pas
View File

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

25
compiler/symdef.pas
View File

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

4
compiler/symsym.pas
View File

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

34
compiler/symtable.pas
View File

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

14
compiler/symtype.pas
View File

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

53
compiler/utils/ppudump.pp
View File

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