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

* Rtti info about Management Operators (MO) in init table for records. Note: commit contains minimal changes for RTL (for proper "make") no functional changes. More RTL changes for fully functionally MO in next commits.

Browse Source 
compiler/ncgrtti.pas
  + write_record_operators procedure which fills simple VMT like table for MO.
  * recorddef_rtti save MO (if exists)
  * objectdef_rtti_fields save nil pointer/entry for objects rtti (have same RTL parts like for records)

compiler/options.pas
  + new define FPC_HAS_MANAGEMENT_OPERATORS

compiler/symconst.pas
  + new item itp_init_record_operators for tinternaltypeprefix enum
  + new entry '$init_record_operators$' in internaltypeprefixName

rtl/inc/rtti.inc
  + new field RecordOp (pointer to MO VMT table) in TRecordInfoInit
  + new types to handle MO VMT: TRTTIRecordOpVMT, PRTTIRecordOpVMT, TRTTIRecCopyOp, TRTTIRecVarOp

rtl/objpas/typinfo.pp
  + RecordOp field for TRecInitData record

git-svn-id: trunk@35445 -
This commit is contained in:
maciej-izak 2017-02-19 00:22:59 +00:00
parent 25db29d0a6
commit af8e0efe57
5 changed files with 84 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
compiler/ncgrtti.pas
View File

@ -1128,6 +1128,51 @@ implementation
end;
procedure recorddef_rtti(def:trecorddef);
procedure write_record_operators;
var
rttilab: Tasmsymbol;
rttidef: tdef;
tcb: ttai_typedconstbuilder;
mop: tmanagementoperator;
procdef: tprocdef;
begin
rttilab := current_asmdata.DefineAsmSymbol(
internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
AB_GLOBAL,AT_DATA,def);
tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
tcb.begin_anonymous_record(
rttilab.Name,
defaultpacking,reqalign,
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign
);
{ use "succ" to omit first enum item "mop_none" }
for mop := succ(low(tmanagementoperator)) to high(tmanagementoperator) do
begin
if not (mop in trecordsymtable(def.symtable).managementoperators) then
tcb.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype)
else
begin
procdef := search_management_operator(mop, def);
if procdef = nil then
internalerror(201603021)
else
tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
cprocvardef.getreusableprocaddr(procdef));
end;
end;
rttidef := tcb.end_anonymous_record;
current_asmdata.AsmLists[al_rtti].concatList(
tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,
sizeof(pint)));
tcb.free;
end;
begin
write_header(tcb,def,tkRecord);
{ need extra reqalign record, because otherwise the u32 int will
@ -1148,8 +1193,22 @@ implementation
tcb.emit_tai(Tai_const.Create_sym(get_rtti_label(def,initrtti,false)),voidpointertype);
tcb.emit_ord_const(def.size,u32inttype);
{ store rtti management operators only for init table }
if (rt=initrtti) then
if (trecordsymtable(def.symtable).managementoperators=[]) then
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
else
tcb.emit_tai(Tai_const.Createname(
internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
AT_DATA_FORCEINDIRECT,0),voidpointertype);
fields_write_rtti_data(tcb,def,rt);
tcb.end_anonymous_record;
{ write pointers to operators if needed }
if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
write_record_operators;
end;
@ -1275,6 +1334,9 @@ implementation
internalerror(2017011801);
tcb.emit_ord_const(def.size, u32inttype);
{ pointer to management operators available only for initrtti }
if (rt=initrtti) then
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ enclosing record takes care of alignment }
fields_write_rtti_data(tcb,def,rt);
end;

1
compiler/options.pas
View File

@ -3359,6 +3359,7 @@ begin
def_system_macro('FPC_HAS_INTERNAL_ABS_INT64');
{$endif x86_64 or powerpc64 or aarch64}
def_system_macro('FPC_HAS_MANAGEMENT_OPERATORS');
def_system_macro('FPC_HAS_UNICODESTRING');
def_system_macro('FPC_RTTI_PACKSET1');
def_system_macro('FPC_HAS_CPSTRING');

2
compiler/symconst.pas
View File

@ -718,6 +718,7 @@ type
itp_rtti_enum_size_start_rec,
itp_rtti_enum_min_max_rec,
itp_rtti_enum_basetype_array_rec,
itp_init_record_operators,
itp_threadvar_record,
itp_objc_method_list,
itp_objc_proto_list,
@ -859,6 +860,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
'$rtti_enum_size_start_rec$',
'$rtti_enum_min_max_rec$',
'$rtti_enum_basetype_array_rec$',
'$init_record_operators$',
'$threadvar_record$',
'$objc_method_list$',
'$objc_proto_list$',

16
rtl/inc/rtti.inc
View File

@ -58,6 +58,21 @@ type
PRecordInfoInit=^TRecordInfoInit;
{$ifndef VER3_0}
TRTTIRecVarOp=procedure(ARec: Pointer);
TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
TRTTIRecOpType=(rotAny, rotInitialize, rotFinalize, rotAddRef, rotCopy);
PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
TRTTIRecordOpVMT=
{$ifdef USE_PACKED}
packed
{$endif USE_PACKED}
record
Initialize: TRTTIRecVarOp;
Finalize: TRTTIRecVarOp;
AddRef: TRTTIRecVarOp;
Copy: TRTTIRecCopyOp;
end;
TRecordInfoInit=
{$ifdef USE_PACKED}
packed
@ -65,6 +80,7 @@ type
record
Terminator: Pointer;
Size: Longint;
RecordOp: PRTTIRecordOpVMT;
Count: Longint;
{ Elements: array[count] of TRecordElement }
end;

3
rtl/objpas/typinfo.pp
View File

@ -340,6 +340,9 @@ unit typinfo;
record
Terminator: Pointer;
Size: Integer;
{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
RecordOp: Pointer;
{$endif}
ManagedFieldCount: Integer;
{ ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
end;