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

* move rtti and vmt table generation into write_persistent_type_info

Browse Source 
* call write_persistent_type_info also for typed consts in interface

git-svn-id: trunk@5239 -
This commit is contained in:
peter 2006-11-05 12:40:13 +00:00
parent dd81f710a3
commit 84a96d66de
3 changed files with 59 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/pdecl.pas
View File

@ -57,9 +57,9 @@ implementation
{ symtable }
symconst,symbase,symtype,symdef,symtable,paramgr,defutil,
{ pass 1 }
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
{ codegen }
ncgutil,ncgrtti,
ncgutil,
{ parser }
scanner,
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@ -230,6 +230,8 @@ implementation
{ add default calling convention }
handle_calling_convention(tabstractprocdef(hdef));
end;
{ write rtti/init tables }
write_persistent_type_info(hdef);
if not skipequal then
begin
{ get init value }
@ -396,7 +398,6 @@ implementation
oldfilepos,
defpos,storetokenpos : tfileposinfo;
old_block_type : tblock_type;
ch : tclassheader;
isgeneric,
isunique,
istyperenaming : boolean;
@ -559,47 +560,7 @@ implementation
{ file position }
oldfilepos:=current_filepos;
current_filepos:=newtype.fileinfo;
{ generate persistent init/final tables when it's declared in the interface so it can
be reused in other used }
if current_module.in_interface {or
(
(is_class(hdef) and
tobjectdef(hdef).members_need_inittable) or
hdef.needs_inittable
) }
then
RTTIWriter.write_rtti(hdef,initrtti);
{ for objects we should write the vmt and interfaces.
This need to be done after the rtti has been written, because
it can contain a reference to that data (PFV)
This is not for forward classes }
if (hdef.typ=objectdef) then
begin
if not(oo_is_forward in tobjectdef(hdef).objectoptions) then
begin
ch:=tclassheader.create(tobjectdef(hdef));
{ generate and check virtual methods, must be done
before RTTI is written }
ch.genvmt;
{ Generate RTTI for class }
RTTIWriter.write_rtti(hdef,fullrtti);
if is_interface(tobjectdef(hdef)) then
ch.writeinterfaceids;
if (oo_has_vmt in tobjectdef(hdef).objectoptions) then
ch.writevmt;
ch.free;
end;
end
else
begin
{ Always generate RTTI info for all types. This is to have typeinfo() return
the same pointer }
if current_module.in_interface then
RTTIWriter.write_rtti(hdef,fullrtti);
end;
write_persistent_type_info(hdef);
current_filepos:=oldfilepos;
end;
until token<>_ID;

59
compiler/ptype.pas
View File

@ -37,17 +37,20 @@ interface
{ object type as function argument type }
testcurobject : byte;
{ reads a string, file type or a type id and returns a name and }
{ tdef }
{ reads a type identifier }
procedure id_type(var def : tdef;isforwarddef:boolean);
{ reads a string, file type or a type identifier }
procedure single_type(var def:tdef;isforwarddef:boolean);
{ reads any type declaration, where the resulting type will get name as type identifier }
procedure read_named_type(var def:tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
{ reads any type declaration }
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
{ reads a type definition }
{ to a appropriating tdef, s gets the name of }
{ the type to allow name mangling }
procedure id_type(var def : tdef;isforwarddef:boolean);
{ generate persistent type information like VMT, RTTI and inittables }
procedure write_persistent_type_info(def : tdef);
implementation
@ -64,7 +67,7 @@ implementation
symconst,symbase,symsym,symtable,
defutil,defcmp,
{ pass 1 }
node,
node,ncgrtti,nobj,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
{ parser }
scanner,
@ -757,6 +760,7 @@ implementation
else
expr_type;
end;
if def=nil then
def:=generrordef;
end;
@ -768,4 +772,45 @@ implementation
end;
procedure write_persistent_type_info(def : tdef);
var
ch : tclassheader;
begin
{ generate persistent init/final tables when it's declared in the interface so it can
be reused in other used }
if def.owner.symtabletype=globalsymtable then
RTTIWriter.write_rtti(def,initrtti);
{ for objects we should write the vmt and interfaces.
This need to be done after the rtti has been written, because
it can contain a reference to that data (PFV)
This is not for forward classes }
if (def.typ=objectdef) then
begin
if not(oo_vmt_written in tobjectdef(def).objectoptions) and
not(oo_is_forward in tobjectdef(def).objectoptions) then
begin
ch:=tclassheader.create(tobjectdef(def));
{ generate and check virtual methods, must be done
before RTTI is written }
ch.genvmt;
{ Generate RTTI for class }
RTTIWriter.write_rtti(def,fullrtti);
if is_interface(tobjectdef(def)) then
ch.writeinterfaceids;
if (oo_has_vmt in tobjectdef(def).objectoptions) then
ch.writevmt;
ch.free;
include(tobjectdef(def).objectoptions,oo_vmt_written);
end;
end
else
begin
{ Always generate RTTI info for all types. This is to have typeinfo() return
the same pointer }
if def.owner.symtabletype=globalsymtable then
RTTIWriter.write_rtti(def,fullrtti);
end;
end;
end.

3
compiler/symconst.pas
View File

@ -305,7 +305,8 @@ type
oo_has_msgstr,
oo_has_msgint,
oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
oo_has_default_property
oo_has_default_property,
oo_vmt_written
);
tobjectoptions=set of tobjectoption;