mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 19:08:15 +02:00
- remove unit info and related code again as that will be handled similar, but differently with dynamic packages
git-svn-id: trunk@42369 -
This commit is contained in:
svenbarth
parent
ee940c8270
commit
e296b26e9e
@ -44,7 +44,7 @@ interface
|
||||
uses
|
||||
cutils,cclasses,cfileutl,
|
||||
globtype,finput,ogbase,fpkg,
|
||||
symbase,symsym,symtype,
|
||||
symbase,symsym,
|
||||
wpobase,
|
||||
aasmbase,aasmdata;
|
||||
|
||||
@ -68,9 +68,6 @@ interface
|
||||
);
|
||||
tmoduleoptions = set of tmoduleoption;
|
||||
|
||||
trtti_moduleoption = (rmo_hasattributes);
|
||||
trtti_moduleoptions = set of trtti_moduleoption;
|
||||
|
||||
tlinkcontaineritem=class(tlinkedlistitem)
|
||||
public
|
||||
data : TPathStr;
|
||||
@ -198,11 +195,6 @@ interface
|
||||
moduleoptions: tmoduleoptions;
|
||||
deprecatedmsg: pshortstring;
|
||||
|
||||
{ contains a reference to the TUnitInfo rtti information for this module }
|
||||
rttiunitinfo : TAsmSymbol;
|
||||
rttiunitinfodef : tdef;
|
||||
rtti_options : trtti_moduleoptions;
|
||||
|
||||
{ contains a list of types that are extended by helper types; the key is
|
||||
the full name of the type and the data is a TFPObjectList of
|
||||
tobjectdef instances (the helper defs) }
|
||||
@ -642,8 +634,6 @@ implementation
|
||||
deprecatedmsg:=nil;
|
||||
namespace:=nil;
|
||||
tcinitcode:=nil;
|
||||
rttiunitinfo:=nil;
|
||||
rttiunitinfodef:=nil;
|
||||
_exports:=TLinkedList.Create;
|
||||
dllscannerinputlist:=TFPHashList.Create;
|
||||
asmdata:=casmdata.create(modulename);
|
||||
|
||||
@ -58,7 +58,6 @@ interface
|
||||
procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
|
||||
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_unit_info_reference(tcb: ttai_typedconstbuilder);
|
||||
procedure write_child_rtti_data(def:tdef;rt:trttitype);
|
||||
procedure write_rtti_reference(tcb: ttai_typedconstbuilder; def: tdef; rt: trttitype);
|
||||
procedure write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;visibilities:tvisibilities);
|
||||
@ -74,8 +73,6 @@ interface
|
||||
function get_rtti_label(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
function get_rtti_label_ord2str(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
function get_rtti_label_str2ord(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
procedure start_write_unit_info;
|
||||
procedure after_write_unit_info(st: TSymtable);
|
||||
end;
|
||||
|
||||
{ generate RTTI and init tables }
|
||||
@ -120,8 +117,6 @@ implementation
|
||||
{ no Delphi-style RTTI for managed platforms }
|
||||
if target_info.system in systems_managed_vm then
|
||||
exit;
|
||||
if current_module.rttiunitinfo=nil then
|
||||
RTTIWriter.start_write_unit_info;
|
||||
for i:=0 to st.DefList.Count-1 do
|
||||
begin
|
||||
def:=tdef(st.DefList[i]);
|
||||
@ -176,8 +171,6 @@ implementation
|
||||
(ds_rtti_table_used in def.defstates) then
|
||||
RTTIWriter.write_rtti(def,fullrtti);
|
||||
end;
|
||||
if st.symtabletype = staticsymtable then
|
||||
RTTIWriter.after_write_unit_info(st);
|
||||
end;
|
||||
|
||||
|
||||
@ -1565,12 +1558,12 @@ implementation
|
||||
{ total number of unique properties }
|
||||
tcb.emit_ord_const(propnamelist.count,u16inttype);
|
||||
|
||||
{ reference to unitinfo with unit-name }
|
||||
write_unit_info_reference(tcb);
|
||||
|
||||
{ TAttributeData }
|
||||
write_attribute_data(tcb, def.rtti_attribute_list);
|
||||
|
||||
{ write unit name }
|
||||
tcb.emit_shortstring_const(current_module.realmodulename^);
|
||||
|
||||
{ write published properties for this object }
|
||||
published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
|
||||
|
||||
@ -1784,11 +1777,6 @@ implementation
|
||||
tcb.emit_tai(Tai_const.Create_sym(tbllab),voidpointertype);
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.write_unit_info_reference(tcb: ttai_typedconstbuilder);
|
||||
begin
|
||||
tcb.emit_tai(Tai_const.Create_sym(current_module.rttiunitinfo), current_module.rttiunitinfodef);
|
||||
end;
|
||||
|
||||
function enumsym_compare_name(item1, item2: pointer): Integer;
|
||||
var
|
||||
enum1: tenumsym absolute item1;
|
||||
@ -2171,37 +2159,6 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.start_write_unit_info;
|
||||
var
|
||||
s : string;
|
||||
tcb: ttai_typedconstbuilder;
|
||||
begin
|
||||
tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
|
||||
tcb.begin_anonymous_record(make_mangledname('RTTIU',current_module.localsymtable,''), 1, sizeof(pint), 1, 1);
|
||||
|
||||
{ write the TRTTIUnitOptions }
|
||||
tcb.emit_ord_const(byte(longint(current_module.rtti_options)),u8inttype);
|
||||
|
||||
{ Write the unit-name }
|
||||
s := current_module.realmodulename^;
|
||||
tcb.emit_shortstring_const(current_module.realmodulename^);
|
||||
|
||||
current_module.rttiunitinfodef := tcb.end_anonymous_record;
|
||||
current_module.rttiunitinfo := current_asmdata.DefineAsmSymbol(make_mangledname('RTTIU_',current_module.localsymtable,''),AB_GLOBAL,AT_DATA, current_module.rttiunitinfodef);
|
||||
current_asmdata.AsmLists[al_rtti].concatList(
|
||||
tcb.get_final_asmlist(current_module.rttiunitinfo,current_module.rttiunitinfodef,sec_rodata,current_module.rttiunitinfo.name,const_align(sizeof(pint))));
|
||||
tcb.free;
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.after_write_unit_info(st: TSymtable);
|
||||
begin
|
||||
if current_module.rttiunitinfo<>nil then
|
||||
begin
|
||||
{ Write a trailing 255 to mark the end of the symbols-list }
|
||||
current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
|
||||
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(255));
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -113,7 +113,6 @@ interface
|
||||
|
||||
class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
|
||||
class procedure InsertInitFinalTable;
|
||||
class procedure InsertRTTIUnitList; virtual;
|
||||
protected
|
||||
class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag); virtual;
|
||||
class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag); virtual;
|
||||
@ -1032,32 +1031,6 @@ implementation
|
||||
release_init_final_list(entries);
|
||||
end;
|
||||
|
||||
class procedure tnodeutils.InsertRTTIUnitList;
|
||||
var
|
||||
hp : tused_unit;
|
||||
unitinits : TAsmList;
|
||||
count : longint;
|
||||
begin
|
||||
unitinits:=TAsmList.Create;
|
||||
count:=0;
|
||||
hp:=tused_unit(usedunits.first);
|
||||
while assigned(hp) do
|
||||
begin
|
||||
unitinits.concat(Tai_const.Createname(make_mangledname('RTTIU_',hp.u.globalsymtable,''),0));
|
||||
inc(count);
|
||||
hp:=tused_unit(hp.next);
|
||||
end;
|
||||
{ Insert TableCount,InitCount at start }
|
||||
unitinits.insert(Tai_const.Create_32bit(count));
|
||||
{ Add to data segment }
|
||||
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
||||
new_section(current_asmdata.asmlists[al_globals],sec_data,'RTTIUNITLIST',sizeof(pint));
|
||||
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('RTTIUNITLIST',AT_DATA,0, carraydef.getreusable(cansichartype,length('RTTIUNITLIST'))));
|
||||
current_asmdata.asmlists[al_globals].concatlist(unitinits);
|
||||
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('RTTIUNITLIST'));
|
||||
unitinits.free;
|
||||
end;
|
||||
|
||||
|
||||
class procedure tnodeutils.insert_init_final_table(entries:tfplist);
|
||||
var
|
||||
|
||||
@ -3263,9 +3263,6 @@ begin
|
||||
else
|
||||
undef_system_macro('FPC_HAS_WINLIKERESOURCES');
|
||||
|
||||
{ RTTI with unitinfo }
|
||||
def_system_macro('FPC_HAS_UNIT_RTTI');
|
||||
|
||||
{ Features }
|
||||
case target_info.system of
|
||||
system_arm_gba:
|
||||
|
||||
@ -460,8 +460,6 @@ implementation
|
||||
if not assigned(rtti_attrs_def) then
|
||||
rtti_attrs_def := trtti_attribute_list.create;
|
||||
rtti_attrs_def.addattribute(typeSym,p1);
|
||||
|
||||
Include(current_module.rtti_options, rmo_hasattributes);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -2407,7 +2407,6 @@ type
|
||||
cnodeutils.InsertWideInitsTablesTable;
|
||||
cnodeutils.InsertResStrTablesTable;
|
||||
cnodeutils.InsertMemorySizes;
|
||||
cnodeutils.InsertRTTIUnitList;
|
||||
|
||||
{ Insert symbol to resource info }
|
||||
cnodeutils.InsertResourceInfo(resources_used);
|
||||
|
||||
@ -978,16 +978,11 @@
|
||||
|
||||
class function TObject.UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
|
||||
type
|
||||
// from the typinfo unit
|
||||
TUnitInfo = packed record
|
||||
UnitOptions: byte;
|
||||
UnitName: shortstring;
|
||||
end;
|
||||
TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
|
||||
ClassType: TClass;
|
||||
ParentInfo: Pointer;
|
||||
PropCount: SmallInt;
|
||||
UnitInfo: ^TUnitInfo;
|
||||
UnitName: ShortString;
|
||||
end;
|
||||
PClassTypeInfo = ^TClassTypeInfo;
|
||||
var
|
||||
@ -1001,7 +996,7 @@
|
||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
classtypeinfo:=aligntoqword(classtypeinfo);
|
||||
{$endif}
|
||||
result:=classtypeinfo^.UnitInfo^.UnitName;
|
||||
result:=classtypeinfo^.UnitName;
|
||||
end
|
||||
else
|
||||
result:='';
|
||||
|
||||
@ -226,19 +226,7 @@ unit TypInfo;
|
||||
property Field[aIndex: Word]: PVmtFieldEntry read GetField;
|
||||
end;
|
||||
|
||||
TRTTIUnitOption = (rmoHasAttributes);
|
||||
TRTTIUnitOptions = set of TRTTIUnitOption;
|
||||
|
||||
{$PACKRECORDS 1}
|
||||
PUnitInfo = ^TUnitInfo;
|
||||
TUnitInfo =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
UnitOptions: TRTTIUnitOptions;
|
||||
UnitName: shortstring;
|
||||
end;
|
||||
|
||||
TTypeInfo = record
|
||||
Kind : TTypeKind;
|
||||
@ -589,7 +577,6 @@ unit TypInfo;
|
||||
{ tkPointer }
|
||||
property RefType: PTypeInfo read GetRefType;
|
||||
public
|
||||
function UnitName: string;
|
||||
case TTypeKind of
|
||||
tkUnKnown,tkLString,tkWString,tkVariant,tkUString:
|
||||
();
|
||||
@ -636,8 +623,8 @@ unit TypInfo;
|
||||
(ClassType : TClass;
|
||||
ParentInfoRef : TypeInfoPtr;
|
||||
PropCount : SmallInt;
|
||||
UnitInfo : PUnitInfo
|
||||
// AttributeTable: PAttributeData;
|
||||
AttributeTable : PAttributeData;
|
||||
UnitName : ShortString;
|
||||
// here the properties follow as array of TPropInfo
|
||||
);
|
||||
tkRecord:
|
||||
@ -767,12 +754,6 @@ unit TypInfo;
|
||||
PPropList = ^TPropList;
|
||||
TPropList = array[0..{$ifdef cpu16}(32768 div sizeof(PPropInfo))-2{$else}65535{$endif}] of PPropInfo;
|
||||
|
||||
PUnitInfoList = ^TUnitInfoList;
|
||||
TUnitInfoList = record
|
||||
UnitCount: IntPtr;
|
||||
Units: array[0..65535] of PUnitInfo;
|
||||
end;
|
||||
|
||||
const
|
||||
tkString = tkSString;
|
||||
tkProcedure = tkProcVar; // for compatibility with Delphi
|
||||
@ -910,10 +891,6 @@ procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value
|
||||
procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
|
||||
|
||||
// Extended RTTI
|
||||
function GetUnitList: PUnitInfoList;
|
||||
function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo;
|
||||
function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo;
|
||||
|
||||
function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
|
||||
|
||||
function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: Word): TCustomAttribute;
|
||||
@ -967,15 +944,6 @@ uses rtlconsts;
|
||||
type
|
||||
PMethod = ^TMethod;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TTypeData methods
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
function TTypeData.UnitName: string;
|
||||
begin
|
||||
Result := UnitInfo^.UnitName
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Auxiliary methods
|
||||
---------------------------------------------------------------------}
|
||||
@ -1006,20 +974,6 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifdef FPC_HAS_UNIT_RTTI}
|
||||
var
|
||||
UnitList: TUnitInfoList; external name 'RTTIUNITLIST';
|
||||
{$endif FPC_HAS_UNIT_RTTI}
|
||||
|
||||
function GetUnitList: PUnitInfoList;
|
||||
begin
|
||||
{$ifdef FPC_HAS_UNIT_RTTI}
|
||||
result := @UnitList;
|
||||
{$else FPC_HAS_UNIT_RTTI}
|
||||
result := nil;
|
||||
{$endif FPC_HAS_UNIT_RTTI}
|
||||
end;
|
||||
|
||||
function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
|
||||
var
|
||||
TD: PTypeData;
|
||||
@ -1029,7 +983,7 @@ begin
|
||||
else
|
||||
begin
|
||||
TD := GetTypeData(TypeInfo);
|
||||
Result:=PAttributeData(PPointer(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)))^)
|
||||
Result:=TD^.AttributeTable;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1037,114 +991,10 @@ function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
|
||||
var
|
||||
p: PtrUInt;
|
||||
begin
|
||||
p := PtrUInt(@TypeData^.UnitInfo) + SizeOf(TypeData^.UnitInfo) + SizeOf(PAttributeData);
|
||||
p := PtrUInt(@TypeData^.UnitName) + SizeOf(TypeData^.UnitName[0]) + Length(TypeData^.UnitName);
|
||||
Result := PPropData(aligntoptr(Pointer(p)));
|
||||
end;
|
||||
|
||||
function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo;
|
||||
begin
|
||||
result := align(pointer(@AUnitInfo^.UnitName)+1+byte(AUnitInfo^.UnitName[0]), sizeof(Pointer));
|
||||
end;
|
||||
|
||||
function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo;
|
||||
type
|
||||
TEnumTableMode=(lookup,search);
|
||||
var
|
||||
p: pointer;
|
||||
td: PTypeData;
|
||||
pd: ppropdata;
|
||||
i: longint;
|
||||
fc: longint;
|
||||
minv,maxv: longint;
|
||||
EnumTableMode: TEnumTableMode;
|
||||
count: pword;
|
||||
begin
|
||||
td := GetTypeData(ATypeInfo);
|
||||
p := GetTypeData(ATypeInfo);
|
||||
case ATypeInfo^.Kind of
|
||||
tkEnumeration:
|
||||
begin
|
||||
p := aligntoptr(p + 1); { OrdType }
|
||||
minv := PLongInt(p)^;
|
||||
p := p + SizeOf(LongInt); { MinValue }
|
||||
maxv := PLongInt(p)^;
|
||||
p := p + SizeOf(LongInt); { MaxValue }
|
||||
p := p + SizeOf(PTypeInfo); { basetype }
|
||||
for i := minv to maxv do
|
||||
p := p + 1 + pbyte(p)^; { NameList: shortstring length + length of string }
|
||||
p := p + 1 + pbyte(p)^; { UnitName: shortstring length + length of string }
|
||||
p := p + 1; { trailing zero }
|
||||
end;
|
||||
tkInteger,
|
||||
tkChar,
|
||||
tkWChar,
|
||||
tkBool : begin
|
||||
p := aligntoptr(p + 1); { OrdType }
|
||||
p := p + SizeOf(LongInt) + SizeOf(LongInt); { MinValue + MaxValue }
|
||||
end;
|
||||
tkSet : begin
|
||||
p := aligntoptr(p + 1); { OrdType }
|
||||
p := p + sizeof(PTypeInfo); { CompType }
|
||||
end;
|
||||
tkQWord : p := p + SizeOf(QWord) + SizeOf(QWord); { MinQWordValue, MaxQWordValue }
|
||||
tkInt64 : p := p + SizeOf(Int64) + SizeOf(Int64); { MinInt64Value, MaxInt64Value }
|
||||
tkSString: p := P + SizeOf(Byte); { MaxLength }
|
||||
tkArray : begin
|
||||
p := p + sizeof(Ptrint); { Element size }
|
||||
p := p + sizeof(PtrInt); { Element count }
|
||||
p := p + sizeof(pointer); { Element type }
|
||||
p := p + sizeof(longint); { Variant type }
|
||||
end;
|
||||
tkDynArray:begin
|
||||
p := p + sizeof(Ptrint); { Element size }
|
||||
p := p + sizeof(PtrInt); { Element type 2 }
|
||||
p := p + sizeof(longint); { Variant type }
|
||||
p := p + sizeof(pointer); { Element type }
|
||||
p := p + 1 + pbyte(p)^; { unitname: shortstring length + length of string }
|
||||
end;
|
||||
tkFloat : begin
|
||||
p := p + sizeof(TFloatType); { Float type }
|
||||
end;
|
||||
tkObject,
|
||||
tkRecord : begin
|
||||
p := p + 4; { Size }
|
||||
fc := plongint(p)^;
|
||||
p := p + 4; { Fieldcount }
|
||||
p := p + (fc * (sizeof(pointer) + 4)); { Fieldcount * (element type + field offset) }
|
||||
end;
|
||||
tkClass : begin
|
||||
pd := GetPropData(ATypeInfo,td);
|
||||
p:=@pd^.PropList;
|
||||
for i:=1 to pd^.PropCount do
|
||||
p:=aligntoptr(pointer(@ppropinfo(p)^.Name)+byte(ppropinfo(p)^.Name[0]));
|
||||
end;
|
||||
tkInterface :
|
||||
begin
|
||||
p := aligntoptr(pointer(@td^.IntfUnit)+byte(td^.IntfUnit[0])+1);
|
||||
p := p+pbyte(p)^+1; { IIDStr }
|
||||
end;
|
||||
tkMethod : begin
|
||||
p := @td^.ParamList[0];
|
||||
for i := 0 to td^.ParamCount-1 do
|
||||
begin
|
||||
p := aligntoptr(p + sizeof(TParamFlags)); { TParamFlags }
|
||||
p := aligntoptr(p +pbyte(p)^+1); { paramname }
|
||||
p := aligntoptr(p +pbyte(p)^+1); { typename }
|
||||
end;
|
||||
if td^.MethodKind in [mkFunction, mkClassFunction] then
|
||||
begin
|
||||
p := aligntoptr(p +pbyte(p)^+1); { resulttype }
|
||||
p := p + sizeof(PPTypeInfo); { resulttyperef }
|
||||
end;
|
||||
p := aligntoptr(p + sizeof(TCallConv)); { cc }
|
||||
p := p + (td^.ParamCount * sizeof(PPTypeInfo));
|
||||
end;
|
||||
end;
|
||||
result := PTypeInfo(align(p,sizeof(p)));
|
||||
if PByte(result)^=255 then
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: Word): TCustomAttribute;
|
||||
var
|
||||
attrtable: PAttributeData;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user