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

* define rtti mangled names for obj-c classes and metaclasses

Browse Source 
(mainly for use in the future to optimize inherited calls)

git-svn-id: branches/objc@13684 -
This commit is contained in:
Jonas Maebe 2009-09-09 22:22:26 +00:00
parent e0b7e8aa55
commit 356ad9893a
2 changed files with 30 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/objcgutl.pas
View File

@ -280,10 +280,11 @@ procedure gen_objc1_classes_sections(list:TAsmList; objclss: tobjectdef; out cla
META_INST_SIZE = 40+8; // sizeof(objc_class) + 8
var
root : tobjectdef;
lbl, metalbl : TAsmLabel;
superStrSym,
classStrSym,
metaisaStrSym : TAsmSymbol;
metaisaStrSym,
metasym,
clssym : TAsmSymbol;
mthdlist,
ivarslist : TAsmLabel;
begin
@ -310,9 +311,9 @@ procedure gen_objc1_classes_sections(list:TAsmList; objclss: tobjectdef; out cla
{ class declaration section }
new_section(list,sec_objc_meta_class,'_OBJC_META_CLASS',sizeof(pint));
{ 1) meta-class declaration }
current_asmdata.getlabel(metalbl,alt_data);
list.Concat(tai_label.Create(metalbl));
{ 1) meta-class declaration (warning: if name changed, also change tclassrefdef.rtti_mangledname) }
metasym:=current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_METACLASS_'+objclss.objextname^,AB_LOCAL,AT_DATA);
list.Concat(tai_symbol.Create(metasym,0));
list.Concat(Tai_const.Create_sym(metaisaStrSym));
{ pointer to the superclass name if any, otherwise nil }
@ -354,11 +355,11 @@ procedure gen_objc1_classes_sections(list:TAsmList; objclss: tobjectdef; out cla
new_section(list,sec_objc_class,'_OBJC_CLASS',sizeof(pint));
current_asmdata.getlabel(lbl,alt_data);
list.Concat(tai_label.Create(lbl));
clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(fullrtti),AB_LOCAL,AT_DATA);
list.Concat(tai_symbol.Create(clssym,0));
{ for class declaration: the is points to the meta-class declaration }
list.Concat(Tai_const.Create_sym(metalbl));
list.Concat(Tai_const.Create_sym(metasym));
{ pointer to the super_class name if any, nil otherwise }
if assigned(superStrSym) then
list.Concat(Tai_const.Create_sym(superStrSym))
@ -391,7 +392,7 @@ procedure gen_objc1_classes_sections(list:TAsmList; objclss: tobjectdef; out cla
{ TODO: From Clang: weak ivar_layout, necessary for garbage collection support }
list.Concat(Tai_const.Create_32bit(0));
classlabel:=lbl;
classlabel:=clssym;
end;

20
compiler/symdef.pas
View File

@ -290,6 +290,7 @@ interface
procedure prepareguid;
function is_publishable : boolean;override;
function needs_inittable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
function vmt_mangledname : string;
procedure check_forwards;
function is_related(d : tdef) : boolean;override;
@ -314,6 +315,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
function GetTypeName:string;override;
function is_publishable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
procedure register_created_object_type;override;
procedure reset;override;
end;
@ -2096,6 +2098,15 @@ implementation
end;
function tclassrefdef.rtti_mangledname(rt: trttitype): string;
begin
if (tobjectdef(pointeddef).objecttype<>odt_objcclass) then
result:=inherited rtti_mangledname(rt)
else
result:=target_asm.labelprefix+'_OBJC_METACLASS_'+tobjectdef(pointeddef).objextname^;
end;
procedure tclassrefdef.reset;
begin
tobjectdef(pointeddef).classref_created_in_current_module:=false;
@ -4280,6 +4291,15 @@ implementation
end;
function tobjectdef.rtti_mangledname(rt: trttitype): string;
begin
if (objecttype<>odt_objcclass) then
result:=inherited rtti_mangledname(rt)
else
result:=target_asm.labelprefix+'_OBJC_CLASS_'+objextname^;
end;
function tobjectdef.members_need_inittable : boolean;
begin
members_need_inittable:=tObjectSymtable(symtable).needs_init_final;