paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 20:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* refactor tclassheader in tvmtbuilder and tvmtwriter

Browse Source 
* fix rtti generation
  * rtti is now written at the end of a module when all info is available,
    this prevents some duplicate rtti entries cause by inheritance

git-svn-id: trunk@5363 -
This commit is contained in:
peter 2006-11-13 22:03:17 +00:00
parent 129ab85aad
commit 9ae8e9fa21
12 changed files with 1127 additions and 1073 deletions

6
compiler/dbgdwarf.pas
View File

@ -612,7 +612,7 @@ implementation
{ Need a new label? }
if not assigned(def.dwarf_lab) then
begin
if (df_has_dwarf_dbg_info in def.defoptions) then
if (ds_dwarf_dbg_info_written in def.defstates) then
begin
if not assigned(def.typesym) then
internalerror(200610011);
@ -628,7 +628,7 @@ implementation
(def.owner.iscurrentunit) then
begin
def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
include(def.defoptions,df_has_dwarf_dbg_info);
include(def.defstates,ds_dwarf_dbg_info_written);
end
else
{ The pointer typecast is needed to prevent a problem with range checking
@ -1388,7 +1388,7 @@ implementation
current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
labsym:=def_dwarf_lab(def);
if df_has_dwarf_dbg_info in def.defoptions then
if ds_dwarf_dbg_info_written in def.defstates then
current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
else
current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));

31
compiler/ncgrtti.pas
View File

@ -68,7 +68,7 @@ implementation
const
rttidefopt : array[trttitype] of tdefoption = (df_has_rttitable,df_has_inittable);
rttidefstate : array[trttitype] of tdefstate = (ds_rtti_table_written,ds_init_table_written);
type
TPropNameListItem = class(TFPHashObject)
@ -831,18 +831,20 @@ implementation
recorddef :
fields_write_rtti(trecorddef(def).symtable,rt);
objectdef :
if rt=initrtti then
fields_write_rtti(tobjectdef(def).symtable,rt)
else
published_write_rtti(tobjectdef(def).symtable,rt);
begin
if assigned(tobjectdef(def).childof) then
write_rtti(tobjectdef(def).childof,rt);
if rt=initrtti then
fields_write_rtti(tobjectdef(def).symtable,rt)
else
published_write_rtti(tobjectdef(def).symtable,rt);
end;
end;
end;
function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
begin
if not(rttidefopt[rt] in def.defoptions) then
internalerror(200611037);
result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
end;
@ -851,14 +853,13 @@ implementation
var
rttilab : tasmsymbol;
begin
if rttidefopt[rt] in def.defoptions then
exit;
{ only write the rttis of defs defined in the current unit,
otherwise we will generate duplicate asmsymbols }
{ only write rtti of definitions from the current module }
if not findunitsymtable(def.owner).iscurrentunit then
internalerror(200611035);
exit;
{ prevent recursion }
include(def.defoptions,rttidefopt[rt]);
if rttidefstate[rt] in def.defstates then
exit;
include(def.defstates,rttidefstate[rt]);
{ write first all dependencies }
write_child_rtti_data(def,rt);
{ write rtti data }
@ -873,9 +874,7 @@ implementation
function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
begin
if not(rttidefopt[rt] in def.defoptions) then
write_rtti(def,rt);
result:=ref_rtti(def,rt);
result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
end;
end.

1907
compiler/nobj.pas
View File

File diff suppressed because it is too large Load Diff

31
compiler/pdecl.pas
View File

@ -57,7 +57,7 @@ implementation
{ symtable }
symconst,symbase,symtype,symdef,symtable,paramgr,defutil,
{ pass 1 }
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
{ codegen }
ncgutil,
{ parser }
@ -235,8 +235,6 @@ 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 }
@ -406,6 +404,7 @@ implementation
istyperenaming : boolean;
generictypelist : TFPObjectList;
generictokenbuf : tdynamicarray;
vmtbuilder : TVMTBuilder;
begin
old_block_type:=block_type;
block_type:=bt_type;
@ -533,7 +532,19 @@ implementation
handle_calling_convention(tprocvardef(hdef));
end;
end;
objectdef,
objectdef :
begin
{ Build VMT indexes, skip for type renaming and forward classes }
if (hdef.typesym=newtype) and
not(oo_is_forward in tobjectdef(hdef).objectoptions) then
begin
vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
vmtbuilder.generate_vmt;
vmtbuilder.free;
end;
try_consume_hintdirective(newtype.symoptions);
consume(_SEMICOLON);
end;
recorddef :
begin
try_consume_hintdirective(newtype.symoptions);
@ -555,18 +566,6 @@ implementation
{ Generic is never a type renaming }
hdef.typesym:=newtype;
end;
{ Write tables if there are no errors and we are the typesym that
defines this type, so this will not be done for simple type renamings }
if (hdef.typ<>errordef) and
(hdef.typesym=newtype) then
begin
{ file position }
oldfilepos:=current_filepos;
current_filepos:=newtype.fileinfo;
write_persistent_type_info(hdef);
current_filepos:=oldfilepos;
end;
until token<>_ID;
typecanbeforward:=false;
symtablestack.top.SymList.ForEachCall(@resolve_type_forward,nil);

4
compiler/pdecobj.pas
View File

@ -179,8 +179,8 @@ implementation
if assigned(def) and
(def.typ=procdef) then
begin
tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
inc(aktobjectdef.lastvtableindex);
// tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
// inc(aktobjectdef.lastvtableindex);
include(tprocdef(def).procoptions,po_virtualmethod);
tprocdef(def).forwarddef:=false;
end;

31
compiler/pmodules.pas
View File

@ -43,7 +43,7 @@ implementation
link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
cresstr,procinfo,
pexports,
scanner,pbase,pexpr,psystem,psub,pdecsub;
scanner,pbase,pexpr,psystem,psub,pdecsub,ptype;
procedure create_objectfile;
@ -1110,10 +1110,6 @@ implementation
{ do we need to add the variants unit? }
maybeloadvariantsunit;
{ generate debuginfo }
if (cs_debuginfo in current_settings.moduleswitches) then
debuginfo.inserttypeinfo;
{ generate wrappers for interfaces }
gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
@ -1121,12 +1117,20 @@ implementation
{ generate pic helpers to load eip if necessary }
gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
{ generate rtti/init tables }
write_persistent_type_info(current_module.globalsymtable);
write_persistent_type_info(current_module.localsymtable);
{ Tables }
insertThreadVars;
{ Resource strings }
GenerateResourceStrings;
{ generate debuginfo }
if (cs_debuginfo in current_settings.moduleswitches) then
debuginfo.inserttypeinfo;
{ generate imports }
if current_module.ImportLibraryList.Count>0 then
importlib.generatelib;
@ -1437,22 +1441,25 @@ implementation
InsertPData;
{$endif arm}
{ generate debuginfo }
if (cs_debuginfo in current_settings.moduleswitches) then
debuginfo.inserttypeinfo;
InsertThreadvars;
{ generate wrappers for interfaces }
gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
{ generate pic helpers to load eip if necessary }
gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
{ generate rtti/init tables }
write_persistent_type_info(current_module.localsymtable);
{ generate wrappers for interfaces }
gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
{ generate imports }
if current_module.ImportLibraryList.Count>0 then
importlib.generatelib;
{ generate debuginfo }
if (cs_debuginfo in current_settings.moduleswitches) then
debuginfo.inserttypeinfo;
if islibrary or (target_info.system in system_unit_program_exports) then
exportlib.generatelib;

3
compiler/psystem.pas
View File

@ -112,9 +112,6 @@ implementation
begin
result:=ttypesym.create(s,def);
systemunit.insert(result);
{ write always RTTI to get persistent typeinfo }
RTTIWriter.write_rtti(def,initrtti);
RTTIWriter.write_rtti(def,fullrtti);
end;
var

93
compiler/ptype.pas
View File

@ -26,7 +26,8 @@ unit ptype;
interface
uses
globtype,cclasses,symtype,symdef;
globtype,cclasses,
symtype,symdef,symbase;
const
{ forward types should only be possible inside a TYPE statement }
@ -50,7 +51,7 @@ interface
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
{ generate persistent type information like VMT, RTTI and inittables }
procedure write_persistent_type_info(def : tdef);
procedure write_persistent_type_info(st:tsymtable);
implementation
@ -64,7 +65,7 @@ implementation
{ target }
paramgr,
{ symtable }
symconst,symbase,symsym,symtable,
symconst,symsym,symtable,
defutil,defcmp,
{ pass 1 }
node,ncgrtti,nobj,
@ -771,43 +772,61 @@ implementation
end;
procedure write_persistent_type_info(def : tdef);
procedure write_persistent_type_info(st:tsymtable);
var
ch : tclassheader;
i : longint;
def : tdef;
vmtwriter : TVMTWriter;
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
for i:=0 to st.DefList.Count-1 do
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
def:=tdef(st.DefList[i]);
if df_deleted in def.defoptions then
continue;
case def.typ of
recorddef :
write_persistent_type_info(trecorddef(def).symtable);
objectdef :
begin
write_persistent_type_info(tobjectdef(def).symtable);
{ Write also VMT }
if not(ds_vmt_written in def.defstates) and
not(oo_is_forward in tobjectdef(def).objectoptions) then
begin
vmtwriter:=TVMTWriter.create(tobjectdef(def));
if is_interface(tobjectdef(def)) then
vmtwriter.writeinterfaceids;
if (oo_has_vmt in tobjectdef(def).objectoptions) then
vmtwriter.writevmt;
vmtwriter.free;
include(def.defstates,ds_vmt_written);
end;
end;
procdef :
begin
if assigned(tprocdef(def).localst) and
(tprocdef(def).localst.symtabletype=localsymtable) then
write_persistent_type_info(tprocdef(def).localst);
if assigned(tprocdef(def).parast) then
write_persistent_type_info(tprocdef(def).parast);
end;
end;
{ generate always persistent tables for types in the interface so it can
be reused in other units and give always the same pointer location. }
{ Init }
if (
assigned(def.typesym) and
(st.symtabletype=globalsymtable)
) or
def.needs_inittable or
(ds_init_table_used in def.defstates) then
RTTIWriter.write_rtti(def,initrtti);
{ RTTI }
if (
assigned(def.typesym) and
(st.symtabletype=globalsymtable)
) or
(ds_rtti_table_used in def.defstates) then
RTTIWriter.write_rtti(def,fullrtti);
end;
end;

20
compiler/symconst.pas
View File

@ -142,12 +142,6 @@ type
{ flags for a definition }
tdefoption=(df_none,
{ init data has been generated }
df_has_inittable,
{ rtti data has been generated }
df_has_rttitable,
{ dwarf debug info has been generated }
df_has_dwarf_dbg_info,
{ type is unique, i.e. declared with type = type <tdef>; }
df_unique,
{ type is a generic }
@ -159,6 +153,17 @@ type
);
tdefoptions=set of tdefoption;
tdefstate=(ds_none,
ds_vmt_written,
ds_rtti_table_used,
ds_init_table_used,
ds_rtti_table_written,
ds_init_table_written,
ds_dwarf_dbg_info_used,
ds_dwarf_dbg_info_written
);
tdefstates=set of tdefstate;
{ tsymlist entry types }
tsltype = (sl_none,
sl_load,
@ -305,8 +310,7 @@ 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_vmt_written
oo_has_default_property
);
tobjectoptions=set of tobjectoption;

26
compiler/symdef.pas
View File

@ -227,6 +227,7 @@ interface
objectoptions : tobjectoptions;
{ to be able to have a variable vmt position }
{ and no vmt field for objects without virtuals }
vmtentries : TFPObjectList;
vmt_offset : longint;
writing_class_record_dbginfo : boolean;
objecttype : tobjecttyp;
@ -919,9 +920,15 @@ implementation
prefix : string[4];
begin
if rt=fullrtti then
prefix:='RTTI'
begin
prefix:='RTTI';
include(defstates,ds_rtti_table_used);
end
else
prefix:='INIT';
begin
prefix:='INIT';
include(defstates,ds_init_table_used);
end;
if assigned(typesym) and
(owner.symtabletype in [staticsymtable,globalsymtable]) then
result:=make_mangledname(prefix,owner,typesym.name)
@ -2151,7 +2158,8 @@ implementation
constructor tarraydef.create_from_pointer(def:tdef);
begin
self.create(0,$7fffffff,s32inttype);
{ use -1 so that the elecount will not overflow }
self.create(0,$7fffffff-1,s32inttype);
arrayoptions:=[ado_IsConvertedPointer];
setelementdef(def);
end;
@ -3560,6 +3568,7 @@ implementation
childof:=nil;
symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
{ create space for vmt !! }
vmtentries:=nil;
vmt_offset:=0;
lastvtableindex:=0;
set_parent(c);
@ -3593,6 +3602,7 @@ implementation
tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
tObjectSymtable(symtable).recordalignment:=ppufile.getbyte;
vmt_offset:=ppufile.getlongint;
vmtentries:=nil;
ppufile.getderef(childofderef);
ppufile.getsmallset(objectoptions);
@ -3658,6 +3668,11 @@ implementation
dispose(iidguid);
iidguid:=nil;
end;
if assigned(vmtentries) then
begin
vmtentries.free;
vmtentries:=nil;
end;
inherited destroy;
end;
@ -3687,6 +3702,11 @@ implementation
for i:=0 to ImplementedInterfaces.count-1 do
tobjectdef(result).ImplementedInterfaces.Add(TImplementedInterface(ImplementedInterfaces[i]).Getcopy);
end;
if assigned(vmtentries) then
begin
tobjectdef(result).vmtentries:=TFPobjectList.Create(false);
tobjectdef(result).vmtentries.Assign(vmtentries);
end;
end;

7
compiler/symtype.pas
View File

@ -60,8 +60,9 @@ interface
dwarf_lab : tasmsymbol;
{ stabs debugging }
stab_number : word;
dbg_state : tdefdbgstatus;
defoptions : tdefoptions;
dbg_state : tdefdbgstatus;
defoptions : tdefoptions;
defstates : tdefstates;
constructor create(dt:tdeftyp);
procedure buildderef;virtual;abstract;
procedure buildderefimpl;virtual;abstract;
@ -193,7 +194,7 @@ interface
current_object_option : tsymoptions = [sp_public];
function FindUnitSymtable(st:TSymtable):TSymtable;
implementation

41
compiler/utils/ppudump.pp
View File

@ -741,35 +741,54 @@ end;
procedure readcommondef(const s:string);
type
{ flags for a definition }
tdefoption=(df_none,
{ init data has been generated }
df_has_inittable,
{ rtti data has been generated }
df_has_rttitable,
{ dwarf debug info has been generated }
df_has_dwarf_dbg_info,
{ type is unique, i.e. declared with type = type <tdef>; }
df_unique,
{ type is a generic }
df_generic,
{ type is a specialization of a generic type }
df_specialization
df_specialization,
{ type is deleted does not to be stored in ppu }
df_deleted
);
tdefoptions=set of tdefoption;
tdefstate=(ds_none,
ds_vmt_written,
ds_rtti_table_used,
ds_init_table_used,
ds_rtti_table_written,
ds_init_table_written,
ds_dwarf_dbg_info_used,
ds_dwarf_dbg_info_written
);
tdefstates=set of tdefstate;
tdefopt=record
mask : tdefoption;
str : string[30];
end;
tdefstateinfo=record
mask : tdefstate;
str : string[30];
end;
const
defopts=6;
defopts=3;
defopt : array[1..defopts] of tdefopt=(
(mask:df_has_inittable; str:'InitTable'),
(mask:df_has_rttitable; str:'RTTITable'),
(mask:df_has_dwarf_dbg_info; str:'Dwarf DbgInfo'),
(mask:df_unique; str:'Unique Type'),
(mask:df_generic; str:'Generic'),
(mask:df_specialization; str:'Specialization')
);
defstateinfos=7;
defstate : array[1..defstateinfos] of tdefstateinfo=(
(mask:ds_init_table_used; str:'InitTable Used'),
(mask:ds_rtti_table_used; str:'RTTITable Used'),
(mask:ds_init_table_written; str:'InitTable Written'),
(mask:ds_rtti_table_written; str:'RTTITable Written'),
(mask:ds_dwarf_dbg_info_used; str:'Dwarf DbgInfo Used'),
(mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written'),
(mask:ds_vmt_written; str:'VMT Written')
);
var
defoptions : tdefoptions;
i : longint;