paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 12:48:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* instead of a flags field generate a table with all Initialize operators of all fields (nested or not, parent class or not) for class types; objects and records don't use this (yet)

Browse Source 
git-svn-id: trunk@39690 -
This commit is contained in:
svenbarth 2018-08-29 19:21:35 +00:00
parent 21e7ddaac7
commit a076677336
6 changed files with 137 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
compiler/ncgrtti.pas
View File

@ -65,7 +65,7 @@ interface
procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
procedure write_paralocs(tcb:ttai_typedconstbuilder;para:pcgpara);
procedure write_param_flag(tcb:ttai_typedconstbuilder;parasym:tparavarsym);
procedure write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
procedure write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
public
constructor create;
procedure write_rtti(def:tdef;rt:trttitype);
@ -175,7 +175,6 @@ implementation
TRTTIWriter
***************************************************************************}
procedure TRTTIWriter.write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;visibilities:tvisibilities);
var
rtticount,
@ -454,13 +453,79 @@ implementation
end;
procedure TRTTIWriter.write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
function compare_mop_offset_entry(item1,item2:pointer):longint;
var
entry1: pmanagementoperator_offset_entry absolute item1;
entry2: pmanagementoperator_offset_entry absolute item2;
begin
{ keep this in sync with the type declaration of TRecordInfoInitFlag(s)
in both rttidecl.inc and typinfo.pp }
if target_info.endian=endian_big then
value:=reverse_longword(value);
tcb.emit_ord_const(value,u32inttype);
if entry1^.offset<entry2^.offset then
result:=-1
else if entry1^.offset>entry2^.offset then
result:=1
else
result:=0;
end;
procedure TRTTIWriter.write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
var
list : tfplist;
datatcb : ttai_typedconstbuilder;
tbllbl : TAsmLabel;
entry : pmanagementoperator_offset_entry;
datadef,entrydef : tdef;
i : longint;
pdef : tobjectdef;
begin
list:=tfplist.create;
tabstractrecordsymtable(def.symtable).get_managementoperator_offset_list(mop,list);
if (def.typ=objectdef) then
begin
pdef:=tobjectdef(def).childof;
while assigned(pdef) do
begin
tabstractrecordsymtable(pdef.symtable).get_managementoperator_offset_list(mop,list);
pdef:=pdef.childof;
end;
list.sort(@compare_mop_offset_entry);
end;
if list.count=0 then
tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype)
else
begin
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_rtti],sec_rodata,'',datatcb,tbllbl);
datatcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
datatcb.emit_ord_const(list.count,u32inttype);
entrydef:=get_recorddef(itp_init_mop_offset_entry,[voidcodepointertype,sizeuinttype],defaultpacking);
for i:=0 to list.count-1 do
begin
entry:=pmanagementoperator_offset_entry(list[i]);
datatcb.maybe_begin_aggregate(entrydef);
datatcb.queue_init(voidcodepointertype);
datatcb.queue_emit_proc(entry^.pd);
datatcb.queue_init(sizeuinttype);
datatcb.queue_emit_ordconst(entry^.offset,sizeuinttype);
datatcb.maybe_end_aggregate(entrydef);
dispose(entry);
end;
datadef:=datatcb.end_anonymous_record;
tcb.finish_internal_data_builder(datatcb,tbllbl,datadef,sizeof(pint));
tcb.emit_tai(tai_const.Create_sym(tbllbl),voidpointertype);
end;
list.free;
end;
@ -1251,10 +1316,8 @@ implementation
{ store rtti management operators only for init table }
if (rt=initrtti) then
begin
riif:=0;
if def.has_non_trivial_init_child(false) then
riif:=riif or riifNonTrivialChild;
write_record_init_flag(tcb,riif);
{ for now records don't have the initializer table }
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
if (trecordsymtable(def.symtable).managementoperators=[]) then
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
else
@ -1407,12 +1470,11 @@ implementation
{ pointer to management operators available only for initrtti }
if (rt=initrtti) then
begin
riif:=0;
if def.has_non_trivial_init_child(false) then
riif:=riif or riifNonTrivialChild;
if assigned(def.childof) and def.childof.has_non_trivial_init_child(true) then
riif:=riif or riifParentHasNonTrivialChild;
write_record_init_flag(tcb,riif);
{ initializer table only available for classes currently }
if def.objecttype=odt_class then
write_mop_offset_table(tcb,def,mop_initialize)
else
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
end;
{ enclosing record takes care of alignment }

2
compiler/symconst.pas
View File

@ -734,6 +734,7 @@ type
itp_rtti_set_outer,
itp_rtti_set_inner,
itp_init_record_operators,
itp_init_mop_offset_entry,
itp_threadvar_record,
itp_objc_method_list,
itp_objc_proto_list,
@ -873,6 +874,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
'$rtti_set_outer$',
'$rtti_set_inner$',
'$init_record_operators$',
'$init_mop_offset_entry$',
'$threadvar_record$',
'$objc_method_list$',
'$objc_proto_list$',

32
rtl/inc/objpas.inc
View File

@ -382,8 +382,9 @@
{$ifndef VER3_0}
var
vmt : PVmt;
temp : pointer;
flags : TRecordInfoInitFlags;
inittable : pointer;
mopinittable : PRTTIRecordOpOffsetTable;
i : longint;
{$endif VER3_0}
begin
{ the size is saved at offset 0 }
@ -397,23 +398,22 @@
{$ifndef VER3_0}
{ for management operators like initialize call int_initialize }
vmt := PVmt(self);
while vmt<>nil do
if assigned(vmt) then
begin
Temp:= vmt^.vInitTable;
if assigned(Temp) then
inittable:=vmt^.vInitTable;
if assigned(inittable) then
begin
flags:=RecordRTTIInitFlags(Temp);
if riifNonTrivialChild in flags then
{ The RTTI format matches one for records, except the type
is tkClass. Since RecordRTTI does not check the type,
calling it yields the desired result. }
RecordRTTI(Instance,Temp,@int_initialize);
{ no need to continue complex initializing up the inheritance
tree if none of the parents require it anyway }
if not (riifParentHasNonTrivialChild in flags) then
break;
mopinittable:=RTTIRecordMopInitTable(inittable);
if assigned(mopinittable) then
begin
{$push}
{ ensure that no range check errors pop up with the [0..0] array }
{$R-}
for i:=0 to mopinittable^.Count-1 do
TRTTIRecVarOp(mopinittable^.Entries[i].ManagmentOperator)(PByte(Instance)+mopinittable^.Entries[i].FieldOffset);
{$pop}
end;
end;
vmt:= vmt^.vParent;
end;
{$endif VER3_0}

4
rtl/inc/rtti.inc
View File

@ -138,10 +138,10 @@ end;
{$ifndef VER3_0}
function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags;
function RTTIRecordMopInitTable(ti: Pointer): PRTTIRecordOpOffsetTable;
begin
ti:=aligntoqword(ti+2+PByte(ti)[1]);
Result:=PRecordInfoInit(ti)^.Flags;
Result:=PRecordInfoInit(ti)^.InitRecordOpTable;
end;
{$endif VER3_0}

38
rtl/inc/rttidecl.inc
View File

@ -92,24 +92,24 @@ type
Copy: TRTTIRecCopyOp;
end;
{$ifndef VER3_0}
{$push}
TRTTIRecordOpOffsetEntry =
{$ifdef USE_PACKED}
packed
{$endif USE_PACKED}
record
ManagmentOperator: CodePointer;
FieldOffset: SizeUInt;
end;
{ better alignment for TRecordInfoInit }
{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and typinfo.pp }
{ ToDo: different values for 8/16-bit platforms? }
{$minenumsize 4}
{$packset 4}
TRecordInfoInitFlag = (
riifNonTrivialChild,
{ only relevant for classes }
riifParentHasNonTrivialChild
);
TRecordInfoInitFlags = set of TRecordInfoInitFlag;
{$pop}
{$endif}
TRTTIRecordOpOffsetTable =
{$ifdef USE_PACKED}
packed
{$endif USE_PACKED}
record
Count: LongWord;
Entries: array[0..0] of TRTTIRecordOpOffsetEntry;
end;
PRTTIRecordOpOffsetTable = ^TRTTIRecordOpOffsetTable;
TRecordInfoInit=
{$ifdef USE_PACKED}
@ -119,7 +119,7 @@ type
Terminator: Pointer;
Size: Longint;
{$ifndef VER3_0}
Flags: TRecordInfoInitFlags;
InitRecordOpTable: PRTTIRecordOpOffsetTable;
RecordOp: PRTTIRecordOpVMT;
{$endif VER3_0}
Count: Longint;
@ -148,7 +148,7 @@ type
{$ifndef VER3_0}
function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags; forward;
function RTTIRecordMopInitTable(ti: Pointer): PRTTIRecordOpOffsetTable; forward;
{$endif VER3_0}
{$ifdef VER3_0}

37
rtl/objpas/typinfo.pp
View File

@ -410,25 +410,24 @@ unit TypInfo;
Entries: array[0..0] of TVmtMethodEntry;
end;
TRecOpOffsetEntry =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
ManagementOperator: CodePointer;
FieldOffset: SizeUInt;
end;
{$ifndef VER3_0}
{$push}
{ better alignment for TRecordInfoInit }
{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and rttidecl.inc }
{ ToDo: different values for 8/16-bit platforms? }
{$minenumsize 4}
{$packset 4}
TRecordInfoInitFlag = (
riifNonTrivialChild,
{ only relevant for classes }
riifParentHasNonTrivialChild
);
TRecordInfoInitFlags = set of TRecordInfoInitFlag;
{$pop}
{$endif}
TRecOpOffsetTable =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
Count: LongWord;
Entries: array[0..0] of TRecOpOffsetEntry;
end;
PRecOpOffsetTable = ^TRecOpOffsetTable;
PRecInitData = ^TRecInitData;
TRecInitData =
@ -439,7 +438,7 @@ unit TypInfo;
Terminator: Pointer;
Size: Integer;
{$ifndef VER3_0}
Flags: TRecordInfoInitFlags;
InitOffsetOp: PRecOpOffsetTable;
ManagementOp: Pointer;
{$endif}
ManagedFieldCount: Integer;