mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 08:00:52 +02:00
* as attributes can be part of any type they are best suited in a common part of TTypeData
git-svn-id: trunk@42375 -
This commit is contained in:
svenbarth
parent
a1b556d211
commit
3ad24c9db8
@ -56,6 +56,7 @@ interface
|
||||
in the same unit as the current one }
|
||||
function ref_rtti(def:tdef;rt:trttitype;indirect:boolean;suffix:tsymstr):tasmsymbol;
|
||||
procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
|
||||
procedure write_common_rtti_data(tcb:ttai_typedconstbuilder;def:tdef;rt:trttitype);
|
||||
procedure write_rtti_data(tcb: ttai_typedconstbuilder; def:tdef; rt: trttitype);
|
||||
procedure write_attribute_data(tcb: ttai_typedconstbuilder;attr_list:trtti_attribute_list);
|
||||
procedure write_child_rtti_data(def:tdef;rt:trttitype);
|
||||
@ -301,6 +302,7 @@ implementation
|
||||
InternalError(201012211);
|
||||
tcb.emit_tai(Tai_const.Create_8bit(typekind),u8inttype);
|
||||
tcb.emit_shortstring_const(name);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
|
||||
@ -565,6 +567,28 @@ implementation
|
||||
tcb.emit_shortstring_const('');
|
||||
end;
|
||||
|
||||
|
||||
procedure TRTTIWriter.write_common_rtti_data(tcb:ttai_typedconstbuilder;def:tdef;rt:trttitype);
|
||||
begin
|
||||
{ important: we need to align this the same way as the type data itself
|
||||
is aligned }
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_common_data],
|
||||
defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
if rt<>fullrtti then
|
||||
begin
|
||||
write_attribute_data(tcb,nil);
|
||||
end
|
||||
else
|
||||
begin
|
||||
write_attribute_data(tcb,tstoreddef(def).rtti_attribute_list);
|
||||
end;
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
|
||||
|
||||
{ writes a 32-bit count followed by array of field infos for given symtable }
|
||||
procedure TRTTIWriter.fields_write_rtti_data(tcb: ttai_typedconstbuilder; def: tabstractrecorddef; rt: trttitype);
|
||||
var
|
||||
@ -918,11 +942,13 @@ implementation
|
||||
begin
|
||||
tcb.emit_ord_const(tkUnknown,u8inttype);
|
||||
write_rtti_name(tcb,def);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
end;
|
||||
|
||||
procedure variantdef_rtti(def:tvariantdef);
|
||||
begin
|
||||
write_header(tcb,def,tkVariant);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
end;
|
||||
|
||||
procedure stringdef_rtti(def:tstringdef);
|
||||
@ -931,6 +957,7 @@ implementation
|
||||
st_ansistring:
|
||||
begin
|
||||
write_header(tcb,def,tkAString);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
{ align }
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_ansistr],
|
||||
@ -942,17 +969,27 @@ implementation
|
||||
end;
|
||||
|
||||
st_widestring:
|
||||
write_header(tcb,def,tkWString);
|
||||
begin
|
||||
write_header(tcb,def,tkWString);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
end;
|
||||
|
||||
st_unicodestring:
|
||||
write_header(tcb,def,tkUString);
|
||||
begin
|
||||
write_header(tcb,def,tkUString);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
end;
|
||||
|
||||
st_longstring:
|
||||
write_header(tcb,def,tkLString);
|
||||
begin
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
write_header(tcb,def,tkLString);
|
||||
end;
|
||||
|
||||
st_shortstring:
|
||||
begin
|
||||
write_header(tcb,def,tkSString);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.emit_ord_const(def.len,u8inttype);
|
||||
end;
|
||||
end;
|
||||
@ -964,6 +1001,7 @@ implementation
|
||||
hp : tenumsym;
|
||||
begin
|
||||
write_header(tcb,def,tkEnumeration);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
{ align; the named fields are so that we can let the compiler
|
||||
calculate the string offsets later on }
|
||||
tcb.next_field_name:='size_start_rec';
|
||||
@ -1039,6 +1077,7 @@ implementation
|
||||
deftrans: byte;
|
||||
begin
|
||||
write_header(tcb,def,typekind);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
deftrans:=trans[def.ordtype];
|
||||
case deftrans of
|
||||
otUQWord,
|
||||
@ -1130,6 +1169,7 @@ implementation
|
||||
scurrency:
|
||||
begin
|
||||
write_header(tcb,def,tkFloat);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_1byte],
|
||||
defaultpacking,reqalign,
|
||||
@ -1151,6 +1191,7 @@ implementation
|
||||
(ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
|
||||
begin
|
||||
write_header(tcb,def,tkFloat);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_1byte],
|
||||
defaultpacking,reqalign,
|
||||
@ -1164,6 +1205,7 @@ implementation
|
||||
procedure setdef_rtti(def:tsetdef);
|
||||
begin
|
||||
write_header(tcb,def,tkSet);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_set_outer],
|
||||
defaultpacking,reqalign,
|
||||
@ -1203,6 +1245,7 @@ implementation
|
||||
else
|
||||
tcb.emit_ord_const(tkArray,u8inttype);
|
||||
write_rtti_name(tcb,def);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
|
||||
if not(ado_IsDynamicArray in def.arrayoptions) then
|
||||
begin
|
||||
@ -1275,6 +1318,7 @@ implementation
|
||||
procedure classrefdef_rtti(def:tclassrefdef);
|
||||
begin
|
||||
write_header(tcb,def,tkClassRef);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_ref],
|
||||
defaultpacking,reqalign,
|
||||
@ -1287,6 +1331,7 @@ implementation
|
||||
procedure pointerdef_rtti(def:tpointerdef);
|
||||
begin
|
||||
write_header(tcb,def,tkPointer);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_ref],
|
||||
defaultpacking,reqalign,
|
||||
@ -1344,6 +1389,7 @@ implementation
|
||||
|
||||
begin
|
||||
write_header(tcb,def,tkRecord);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
{ need extra reqalign record, because otherwise the u32 int will
|
||||
only be aligned to 4 even on 64 bit target (while the rtti code
|
||||
in typinfo expects alignments to sizeof(pointer)) }
|
||||
@ -1427,6 +1473,7 @@ implementation
|
||||
begin
|
||||
{ write method id and name }
|
||||
write_header(tcb,def,tkMethod);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record('',defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
@ -1469,6 +1516,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
write_header(tcb,def,tkProcvar);
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
tcb.begin_anonymous_record('',defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
@ -1558,9 +1606,6 @@ implementation
|
||||
{ total number of unique properties }
|
||||
tcb.emit_ord_const(propnamelist.count,u16inttype);
|
||||
|
||||
{ TAttributeData }
|
||||
write_attribute_data(tcb, def.rtti_attribute_list);
|
||||
|
||||
{ write unit name }
|
||||
tcb.emit_shortstring_const(current_module.realmodulename^);
|
||||
|
||||
@ -1654,6 +1699,8 @@ implementation
|
||||
{ generate the name }
|
||||
tcb.emit_shortstring_const(def.objrealname^);
|
||||
|
||||
write_common_rtti_data(tcb,def,rt);
|
||||
|
||||
tcb.begin_anonymous_record('',defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
|
||||
@ -730,6 +730,7 @@ type
|
||||
itp_vmt_afterconstruction_local,
|
||||
itp_rttidef,
|
||||
itp_rtti_header,
|
||||
itp_rtti_common_data,
|
||||
itp_rtti_prop,
|
||||
itp_rtti_ansistr,
|
||||
itp_rtti_ord_outer,
|
||||
@ -870,6 +871,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
|
||||
'$vmt_afterconstruction_local',
|
||||
'$rttidef$',
|
||||
'$rtti_header$',
|
||||
'$rtti_common_data$',
|
||||
'$rtti_prop$',
|
||||
'$rtti_ansistr$',
|
||||
'$rtti_ord_outer$',
|
||||
|
||||
@ -39,6 +39,9 @@ type
|
||||
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
{$if declared(TRttiDataCommon)}
|
||||
common: TRttiDataCommon;
|
||||
{$endif declared TRttiDataCommon}
|
||||
elSize : SizeUInt;
|
||||
{$ifdef VER3_0}
|
||||
elType2 : Pointer;
|
||||
|
||||
@ -979,6 +979,7 @@
|
||||
class function TObject.UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
|
||||
type
|
||||
TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
|
||||
Attributes: Pointer;
|
||||
ClassType: TClass;
|
||||
ParentInfo: Pointer;
|
||||
PropCount: SmallInt;
|
||||
|
||||
@ -67,6 +67,9 @@ type
|
||||
packed
|
||||
{$endif USE_PACKED}
|
||||
record
|
||||
{$if declared(TRttiDataCommon)}
|
||||
Common: TRttiDataCommon;
|
||||
{$endif declared TRttiDataCommon}
|
||||
{$ifndef VER3_0}
|
||||
InitTable: Pointer;
|
||||
{$endif VER3_0}
|
||||
@ -116,6 +119,9 @@ type
|
||||
packed
|
||||
{$endif USE_PACKED}
|
||||
record
|
||||
{$if declared(TRttiDataCommon)}
|
||||
Common: TRttiDataCommon;
|
||||
{$endif declared TRttiDataCommon}
|
||||
Terminator: Pointer;
|
||||
Size: Longint;
|
||||
{$ifndef VER3_0}
|
||||
@ -135,6 +141,9 @@ type
|
||||
packed
|
||||
{$endif USE_PACKED}
|
||||
record
|
||||
{$if declared(TRttiDataCommon)}
|
||||
Common: TRttiDataCommon;
|
||||
{$endif declared TRttiDataCommon}
|
||||
Size: SizeInt;
|
||||
ElCount: SizeInt;
|
||||
{$ifdef VER3_0}
|
||||
|
||||
@ -488,6 +488,19 @@ function aligntoqword(p : pointer) : pointer;inline;
|
||||
Run-Time Type Information (RTTI) declarations
|
||||
****************************************************************************}
|
||||
|
||||
{$if defined(FPC_HAS_FEATURE_RTTI) or defined(FPC_HAS_FEATURE_DYNARRAYS)}
|
||||
{$if not defined(VER3_0) and not defined(VER3_2)}
|
||||
type
|
||||
TRttiDataCommon =
|
||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif}
|
||||
record
|
||||
Attrs: Pointer;
|
||||
end;
|
||||
{$endif not VER3_0 and not VER3_2}
|
||||
{$endif FPC_HAS_FEATURE_RTTI or FPC_HAS_FEATURE_DYNARRAYS}
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_RTTI}
|
||||
{$i rttidecl.inc}
|
||||
{$endif FPC_HAS_FEATURE_RTTI}
|
||||
|
||||
@ -451,6 +451,7 @@ unit TypInfo;
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
AttributeTable : PAttributeTable;
|
||||
Terminator: Pointer;
|
||||
Size: Integer;
|
||||
{$ifndef VER3_0}
|
||||
@ -472,6 +473,7 @@ unit TypInfo;
|
||||
function GetPropertyTable: PPropData; inline;
|
||||
function GetMethodTable: PIntfMethodTable; inline;
|
||||
public
|
||||
AttributeTable : PAttributeTable;
|
||||
Parent: PPTypeInfo;
|
||||
Flags: TIntfFlagsBase;
|
||||
GUID: TGUID;
|
||||
@ -496,6 +498,7 @@ unit TypInfo;
|
||||
function GetPropertyTable: PPropData; inline;
|
||||
function GetMethodTable: PIntfMethodTable; inline;
|
||||
public
|
||||
AttributeTable : PAttributeTable;
|
||||
Parent: PPTypeInfo;
|
||||
Flags : TIntfFlagsBase;
|
||||
IID: TGUID;
|
||||
@ -519,10 +522,10 @@ unit TypInfo;
|
||||
function GetUnitName: ShortString; inline;
|
||||
function GetPropertyTable: PPropData; inline;
|
||||
public
|
||||
AttributeTable : PAttributeTable;
|
||||
ClassType : TClass;
|
||||
Parent : PPTypeInfo;
|
||||
PropCount : SmallInt;
|
||||
AttributeTable : PAttributeTable;
|
||||
property UnitName: ShortString read GetUnitName;
|
||||
property PropertyTable: PPropData read GetPropertyTable;
|
||||
private
|
||||
@ -579,6 +582,7 @@ unit TypInfo;
|
||||
{ tkPointer }
|
||||
property RefType: PTypeInfo read GetRefType;
|
||||
public
|
||||
AttributeTable : PAttributeTable;
|
||||
case TTypeKind of
|
||||
tkUnKnown,tkLString,tkWString,tkVariant,tkUString:
|
||||
();
|
||||
@ -625,7 +629,6 @@ unit TypInfo;
|
||||
(ClassType : TClass;
|
||||
ParentInfoRef : TypeInfoPtr;
|
||||
PropCount : SmallInt;
|
||||
AttributeTable : PAttributeTable;
|
||||
UnitName : ShortString;
|
||||
// here the properties follow as array of TPropInfo
|
||||
);
|
||||
@ -980,13 +983,8 @@ function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
|
||||
var
|
||||
TD: PTypeData;
|
||||
begin
|
||||
if TypeInfo^.Kind<>tkClass then
|
||||
result := nil
|
||||
else
|
||||
begin
|
||||
TD := GetTypeData(TypeInfo);
|
||||
Result:=TD^.AttributeTable;
|
||||
end;
|
||||
TD := GetTypeData(TypeInfo);
|
||||
Result:=TD^.AttributeTable;
|
||||
end;
|
||||
|
||||
function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData; inline;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user