mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:39:40 +01:00 
			
		
		
		
	conflicts in case a protocol is adopted by classes in multiple object
    files part of the same binary (mantis #20875)
git-svn-id: trunk@19865 -
		
	
			
		
			
				
	
	
		
			1626 lines
		
	
	
		
			58 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1626 lines
		
	
	
		
			58 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						||
    Copyright (c) 2009 by Jonas Maebe
 | 
						||
 | 
						||
    This unit implements some Objective-C helper routines at the code generator
 | 
						||
    level.
 | 
						||
 | 
						||
    This program is free software; you can redistribute it and/or modify
 | 
						||
    it under the terms of the GNU General Public License as published by
 | 
						||
    the Free Software Foundation; either version 2 of the License,or
 | 
						||
    (at your option) any later version.
 | 
						||
 | 
						||
    This program is distributed in the hope that it will be useful,
 | 
						||
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						||
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
						||
    GNU General Public License for more details.
 | 
						||
 | 
						||
    You should have received a copy of the GNU General Public License
 | 
						||
    along with this program; if not, write to the Free Software
 | 
						||
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | 
						||
 | 
						||
 ****************************************************************************
 | 
						||
}
 | 
						||
 | 
						||
{$i fpcdefs.inc}
 | 
						||
 | 
						||
unit objcgutl;
 | 
						||
 | 
						||
interface
 | 
						||
 | 
						||
  uses
 | 
						||
    cclasses,
 | 
						||
    aasmbase,aasmdata,
 | 
						||
    symbase,symdef;
 | 
						||
 | 
						||
  procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype);
 | 
						||
  procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef);
 | 
						||
 | 
						||
  procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable);
 | 
						||
 | 
						||
 | 
						||
implementation
 | 
						||
 | 
						||
  uses
 | 
						||
    globtype,globals,fmodule,
 | 
						||
    systems,
 | 
						||
    aasmtai,
 | 
						||
    cgbase,
 | 
						||
    objcdef,objcutil,
 | 
						||
    symconst,symtype,symsym,symtable,
 | 
						||
    verbose;
 | 
						||
 | 
						||
  type
 | 
						||
    tobjcabi = (oa_fragile, oa_nonfragile);
 | 
						||
(*    tivarlayouttype = (il_weak,il_strong); *)
 | 
						||
 | 
						||
    tobjcrttiwriter = class
 | 
						||
     protected
 | 
						||
      fabi: tobjcabi;
 | 
						||
      classdefs,
 | 
						||
      catdefs: tfpobjectlist;
 | 
						||
      classsyms,
 | 
						||
      catsyms: tfpobjectlist;
 | 
						||
      procedure gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmlabel; classmethods, iscategory: Boolean);
 | 
						||
      procedure gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel);
 | 
						||
      procedure gen_objc_protocol_list(list:TAsmList; protolist: TFPObjectList; out protolistsym: TAsmLabel);
 | 
						||
      procedure gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype;const sectname: string; out listsym: TAsmLabel);
 | 
						||
 | 
						||
      procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);virtual;abstract;
 | 
						||
      procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);virtual;abstract;
 | 
						||
      procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);virtual;abstract;
 | 
						||
      procedure gen_objc_info_sections(list: tasmlist);virtual;abstract;
 | 
						||
     public
 | 
						||
      constructor create(_abi: tobjcabi);
 | 
						||
      destructor destroy;override;
 | 
						||
      procedure gen_objc_rtti_sections(list:TAsmList; st:TSymtable);
 | 
						||
      property abi: tobjcabi read fabi;
 | 
						||
    end;
 | 
						||
 | 
						||
 | 
						||
    { Used by by PowerPC/32 and i386 }
 | 
						||
    tobjcrttiwriter_fragile = class(tobjcrttiwriter)
 | 
						||
     protected
 | 
						||
      function gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel;
 | 
						||
      procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
 | 
						||
      procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_info_sections(list: tasmlist);override;
 | 
						||
     public
 | 
						||
      constructor create;
 | 
						||
    end;
 | 
						||
 | 
						||
 | 
						||
    { Used by PowerPC/64, ARM, and x86_64 }
 | 
						||
    tobjcrttiwriter_nonfragile = class(tobjcrttiwriter)
 | 
						||
     protected
 | 
						||
      ObjCEmptyCacheVar,
 | 
						||
      ObjCEmptyVtableVar: TAsmSymbol;
 | 
						||
 | 
						||
      procedure gen_objc_class_ro_part(list: TAsmList; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: TAsmSymbol; metaclass: boolean);
 | 
						||
      procedure addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist);
 | 
						||
 | 
						||
      procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
 | 
						||
      procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);override;
 | 
						||
      procedure gen_objc_info_sections(list: tasmlist);override;
 | 
						||
     public
 | 
						||
      constructor create;
 | 
						||
    end;
 | 
						||
 | 
						||
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                    Protocol declaration helpers
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
function objcfindprotocolentry(const p: shortstring): TAsmSymbol;
 | 
						||
  var
 | 
						||
    item  : PHashSetItem;
 | 
						||
  begin
 | 
						||
    result:=nil;
 | 
						||
    if not assigned(current_asmdata.ConstPools[sp_objcprotocolrefs]) then
 | 
						||
      exit;
 | 
						||
    item:=current_asmdata.constpools[sp_objcprotocolrefs].Find(@p[1], length(p));
 | 
						||
    if not assigned(item) then
 | 
						||
      exit;
 | 
						||
    result:=TAsmSymbol(item^.Data);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
function objcaddprotocolentry(const p: shortstring; ref: TAsmSymbol): Boolean;
 | 
						||
  var
 | 
						||
    item  : PHashSetItem;
 | 
						||
  begin
 | 
						||
    item:=current_asmdata.constpools[sp_objcprotocolrefs].FindOrAdd(@p[1], length(p));
 | 
						||
    Result:=(item^.Data=nil);
 | 
						||
    if Result then
 | 
						||
      item^.Data:=ref;
 | 
						||
  end;
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                       Pool section helpers
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
function objcreatestringpoolentryintern(p: pchar; len: longint; pooltype: tconstpooltype; stringsec: tasmsectiontype): TAsmSymbol;
 | 
						||
  var
 | 
						||
    entry  : PHashSetItem;
 | 
						||
    strlab : tasmlabel;
 | 
						||
    pc     : pchar;
 | 
						||
    pool   : THashSet;
 | 
						||
  begin
 | 
						||
    pool := current_asmdata.constpools[pooltype];
 | 
						||
 | 
						||
    entry:=pool.FindOrAdd(p,len);
 | 
						||
    if not assigned(entry^.data) then
 | 
						||
      begin
 | 
						||
        { create new entry }
 | 
						||
        current_asmdata.getlabel(strlab,alt_data);
 | 
						||
        entry^.Data:=strlab;
 | 
						||
        getmem(pc,entry^.keylength+1);
 | 
						||
        move(entry^.key^,pc^,entry^.keylength);
 | 
						||
        pc[entry^.keylength]:=#0;
 | 
						||
 | 
						||
        { add the string to the approriate section }
 | 
						||
        new_section(current_asmdata.asmlists[al_objc_pools],stringsec,strlab.name,0);
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(strlab));
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_string.Create_pchar(pc,entry^.keylength+1));
 | 
						||
        Result := strlab;
 | 
						||
      end
 | 
						||
    else
 | 
						||
      Result := TAsmLabel(Entry^.Data);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype);
 | 
						||
  var
 | 
						||
    reflab : tasmlabel;
 | 
						||
    strlab : tasmsymbol;
 | 
						||
    classname: string;
 | 
						||
  begin
 | 
						||
    { have we already generated a reference for this string entry? }
 | 
						||
    if not assigned(entry^.Data) then
 | 
						||
      begin
 | 
						||
        { no, add the string to the associated strings section }
 | 
						||
        strlab:=objcreatestringpoolentryintern(pchar(entry^.key),entry^.keylength,stringpool,stringsec);
 | 
						||
 | 
						||
        { and now finish the reference }
 | 
						||
        current_asmdata.getlabel(reflab,alt_data);
 | 
						||
        entry^.Data:=reflab;
 | 
						||
 | 
						||
        { add a pointer to the string in the string references section }
 | 
						||
        new_section(current_asmdata.asmlists[al_objc_pools],refsec,reflab.name,sizeof(pint));
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(reflab));
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_const.Create_sym(strlab));
 | 
						||
 | 
						||
        { in case of a class reference, also add a lazy symbol reference for
 | 
						||
          the class (the linker requires this for the fragile ABI). }
 | 
						||
        if (refsec=sec_objc_cls_refs) and
 | 
						||
           not(target_info.system in systems_objc_nfabi) then
 | 
						||
          begin
 | 
						||
            setlength(classname,entry^.keylength);
 | 
						||
            move(entry^.key^,classname[1],entry^.keylength);
 | 
						||
            current_asmdata.asmlists[al_objc_pools].concat(tai_directive.Create(asd_lazy_reference,'.objc_class_name_'+classname));
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
function objcreatestringpoolentry(const s: string; pooltype: tconstpooltype; stringsec: tasmsectiontype): TAsmSymbol;
 | 
						||
  begin
 | 
						||
    result:=objcreatestringpoolentryintern(@s[1],length(s),pooltype,stringsec);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef);
 | 
						||
  var
 | 
						||
    reflab: TAsmLabel;
 | 
						||
    classym: TasmSymbol;
 | 
						||
  begin
 | 
						||
    { have we already generated a reference for this class ref entry? }
 | 
						||
    if not assigned(entry^.Data) then
 | 
						||
      begin
 | 
						||
        { no, add the classref to the sec_objc_cls_refs section }
 | 
						||
        current_asmdata.getlabel(reflab,alt_data);
 | 
						||
        entry^.Data:=reflab;
 | 
						||
 | 
						||
        { add a pointer to the class }
 | 
						||
        new_section(current_asmdata.asmlists[al_objc_pools],sec_objc_cls_refs,reflab.name,sizeof(pint));
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(reflab));
 | 
						||
        classym:=current_asmdata.RefAsmSymbol(classdef.rtti_mangledname(objcclassrtti));
 | 
						||
        current_asmdata.asmlists[al_objc_pools].concat(Tai_const.Create_sym(classym));
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                    RTTI generation -- Helpers
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
procedure ConcatSymOrNil(list: tasmlist; sym: TAsmSymbol); inline;
 | 
						||
begin
 | 
						||
  if Assigned(sym) then
 | 
						||
    list.Concat(tai_const.Create_sym(sym))
 | 
						||
  else
 | 
						||
    list.Concat(tai_const.Create_pint(0));
 | 
						||
end;
 | 
						||
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                 RTTI generation -- Common
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
{ generate a method list, either of class methods or of instance methods,
 | 
						||
  and both for obj-c classes and categories. }
 | 
						||
procedure tobjcrttiwriter.gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmlabel; classmethods, iscategory: Boolean);
 | 
						||
  const
 | 
						||
    clsSectType : array [Boolean] of tasmsectiontype = (sec_objc_inst_meth, sec_objc_cls_meth);
 | 
						||
    clsSectName : array [Boolean] of string = ('_OBJC_INST_METH','_OBJC_CLS_METH');
 | 
						||
    catSectType : array [Boolean] of tasmsectiontype = (sec_objc_cat_inst_meth, sec_objc_cat_cls_meth);
 | 
						||
    catSectName : array [Boolean] of string = ('_OBJC_CAT_INST_METH','_OBJC_CAT_CLS_METH');
 | 
						||
  type
 | 
						||
    method_data = record
 | 
						||
      def     : tprocdef;
 | 
						||
      selsym  : TAsmSymbol;
 | 
						||
      encsym  : TAsmSymbol;
 | 
						||
    end;
 | 
						||
  var
 | 
						||
    i     : Integer;
 | 
						||
    def   : tprocdef;
 | 
						||
    defs  : array of method_data;
 | 
						||
    mcnt  : integer;
 | 
						||
    sym   : tasmsymbol;
 | 
						||
    mtype : tdef;
 | 
						||
  begin
 | 
						||
    methodslabel:=nil;
 | 
						||
    mcnt:=0;
 | 
						||
    { collect all instance/class methods }
 | 
						||
    SetLength(defs,objccls.vmtentries.count);
 | 
						||
    for i:=0 to objccls.vmtentries.count-1 do
 | 
						||
      begin
 | 
						||
        def:=pvmtentry(objccls.vmtentries[i])^.procdef;
 | 
						||
        if (def.owner.defowner=objccls) and
 | 
						||
           (classmethods = (po_classmethod in def.procoptions)) then
 | 
						||
          begin
 | 
						||
            defs[mcnt].def:=def;
 | 
						||
            defs[mcnt].selsym:=objcreatestringpoolentry(def.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names);
 | 
						||
            defs[mcnt].encsym:=objcreatestringpoolentry(objcencodemethod(def),sp_objcvartypes,sec_objc_meth_var_types);
 | 
						||
            inc(mcnt);
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
    if mcnt=0 then
 | 
						||
      exit;
 | 
						||
 | 
						||
    if iscategory then
 | 
						||
      new_section(list,catSectType[classmethods],catSectName[classmethods],sizeof(ptrint))
 | 
						||
    else
 | 
						||
      new_section(list,clsSectType[classmethods],clsSectName[classmethods],sizeof(ptrint));
 | 
						||
 | 
						||
    current_asmdata.getlabel(methodslabel,alt_data);
 | 
						||
    list.Concat(tai_label.Create(methodslabel));
 | 
						||
 | 
						||
    if (abi=oa_fragile) then
 | 
						||
      { not used, always zero }
 | 
						||
      list.Concat(tai_const.Create_32bit(0))
 | 
						||
    else
 | 
						||
      begin
 | 
						||
        { size of each entry -- always 32 bit value }
 | 
						||
        mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef;
 | 
						||
        list.Concat(tai_const.Create_32bit(mtype.size));
 | 
						||
      end;
 | 
						||
    { number of objc_method entries in the method_list array -- always 32 bit}
 | 
						||
    list.Concat(tai_const.Create_32bit(mcnt));
 | 
						||
    for i:=0 to mcnt-1 do
 | 
						||
      begin
 | 
						||
        { reference to the selector name }
 | 
						||
        list.Concat(tai_const.Create_sym(defs[i].selsym));
 | 
						||
        { reference to the obj-c encoded function parameters (signature) }
 | 
						||
        list.Concat(tai_const.Create_sym(defs[i].encsym));
 | 
						||
        { mangled name of the method }
 | 
						||
        sym:=current_asmdata.GetAsmSymbol(defs[i].def.mangledname);
 | 
						||
        if not assigned(sym) then
 | 
						||
          internalerror(2009091601);
 | 
						||
        list.Concat(tai_const.Create_sym(sym));
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{ generate method (and in the future also property) info for protocols }
 | 
						||
procedure tobjcrttiwriter.gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel);
 | 
						||
  var
 | 
						||
    proc          : tprocdef;
 | 
						||
    reqinstmlist,
 | 
						||
    reqclsmlist,
 | 
						||
    optinstmlist,
 | 
						||
    optclsmlist   : TFPObjectList;
 | 
						||
    i             : ptrint;
 | 
						||
  begin
 | 
						||
    reqinstmlist:=TFPObjectList.Create(false);
 | 
						||
    reqclsmlist:=TFPObjectList.Create(false);
 | 
						||
    optinstmlist:=TFPObjectList.Create(false);
 | 
						||
    optclsmlist:=TFPObjectList.Create(false);
 | 
						||
    for i:=0 to protocol.vmtentries.Count-1 do
 | 
						||
      begin
 | 
						||
        proc:=pvmtentry(protocol.vmtentries[i])^.procdef;
 | 
						||
        if (po_classmethod in proc.procoptions) then
 | 
						||
          if not(po_optional in proc.procoptions) then
 | 
						||
            reqclsmlist.Add(proc)
 | 
						||
          else
 | 
						||
            optclsmlist.Add(proc)
 | 
						||
        else if not(po_optional in proc.procoptions) then
 | 
						||
          reqinstmlist.Add(proc)
 | 
						||
        else
 | 
						||
          optinstmlist.Add(proc);
 | 
						||
      end;
 | 
						||
    if reqinstmlist.Count > 0 then
 | 
						||
      gen_objc_cat_methods(list,reqinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',reqinstsym)
 | 
						||
    else
 | 
						||
      reqinstsym:=nil;
 | 
						||
    if optinstmlist.Count > 0 then
 | 
						||
      gen_objc_cat_methods(list,optinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',optinstsym)
 | 
						||
    else
 | 
						||
      optinstsym:=nil;
 | 
						||
 | 
						||
    if reqclsmlist.Count>0 then
 | 
						||
      gen_objc_cat_methods(list,reqclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',reqclssym)
 | 
						||
    else
 | 
						||
      reqclssym:=nil;
 | 
						||
    if optclsmlist.Count>0 then
 | 
						||
      gen_objc_cat_methods(list,optclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',optclssym)
 | 
						||
    else
 | 
						||
      optclssym:=nil;
 | 
						||
 | 
						||
    reqinstmlist.Free;
 | 
						||
    reqclsmlist.Free;
 | 
						||
    optinstmlist.Free;
 | 
						||
    optclsmlist.Free;
 | 
						||
end;
 | 
						||
 | 
						||
 | 
						||
(*
 | 
						||
From CLang:
 | 
						||
 | 
						||
  struct objc_protocol_list
 | 
						||
  {
 | 
						||
#ifdef FRAGILE_ABI
 | 
						||
      struct objc_protocol_list *next;
 | 
						||
      int count;
 | 
						||
#else
 | 
						||
      long count;
 | 
						||
#endif
 | 
						||
      Protocol *list[1];
 | 
						||
  };
 | 
						||
*)
 | 
						||
procedure tobjcrttiwriter.gen_objc_protocol_list(list: tasmlist; protolist: tfpobjectlist; out protolistsym: tasmlabel);
 | 
						||
  var
 | 
						||
    i         : Integer;
 | 
						||
    protosym  : TAsmSymbol;
 | 
						||
    protodef  : tobjectdef;
 | 
						||
  begin
 | 
						||
    if not Assigned(protolist) or
 | 
						||
       (protolist.Count=0) then
 | 
						||
      begin
 | 
						||
        protolistsym:=nil;
 | 
						||
        Exit;
 | 
						||
      end;
 | 
						||
 | 
						||
    for i:=0 to protolist.Count-1 do
 | 
						||
      begin
 | 
						||
        protodef:=TImplementedInterface(protolist[i]).IntfDef;
 | 
						||
        protosym:=objcfindprotocolentry(protodef.objextname^);
 | 
						||
        if not assigned(protosym) then
 | 
						||
          begin
 | 
						||
            gen_objc_protocol(list,protodef,protosym);
 | 
						||
            objcaddprotocolentry(protodef.objextname^,protosym);
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
 | 
						||
    { protocol lists are stored in .objc_cat_cls_meth section }
 | 
						||
    new_section(list,sec_objc_cat_cls_meth,'_OBJC_PROTOCOLLIST',sizeof(pint));
 | 
						||
    current_asmdata.getlabel(protolistsym, alt_data);
 | 
						||
    list.Concat(tai_label.Create(protolistsym));
 | 
						||
 | 
						||
    if (abi=oa_fragile) then
 | 
						||
      { From Clang: next, always nil}
 | 
						||
      list.Concat(tai_const.Create_pint(0));
 | 
						||
    { From Clang: protocols count}
 | 
						||
    list.Concat(Tai_const.Create_pint(protolist.Count));
 | 
						||
    for i:=0 to protolist.Count-1 do
 | 
						||
      begin
 | 
						||
        protodef:=(protolist[i] as TImplementedInterface).IntfDef;
 | 
						||
        protosym:=objcfindprotocolentry(protodef.objextname^);
 | 
						||
        if not Assigned(protosym) then
 | 
						||
          begin
 | 
						||
            { For some reason protosym is not declared, though must be!
 | 
						||
              Probably gen_obcj1_protocol returned wrong protosym
 | 
						||
            }
 | 
						||
            InternalError(2009091602);
 | 
						||
          end;
 | 
						||
        list.Concat(tai_const.Create_sym(protosym));
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{ Generate rtti for an Objective-C methods (methods without implementation) }
 | 
						||
{ items : TFPObjectList of Tprocdef }
 | 
						||
procedure tobjcrttiwriter.gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype;
 | 
						||
  const sectname: string; out listsym: TAsmLabel);
 | 
						||
var
 | 
						||
  i     : integer;
 | 
						||
  m     : tprocdef;
 | 
						||
  mtype : tdef;
 | 
						||
begin
 | 
						||
  if not assigned(items) or
 | 
						||
     (items.count=0) then
 | 
						||
    exit;
 | 
						||
 | 
						||
  new_section(list, section, sectname, sizeof(pint));
 | 
						||
  current_asmdata.getlabel(listsym,alt_data);
 | 
						||
  list.Concat(tai_label.Create(listsym));
 | 
						||
  if (abi=oa_nonfragile) then
 | 
						||
    begin
 | 
						||
      { size of each entry -- always 32 bit value }
 | 
						||
      mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef;
 | 
						||
      list.Concat(tai_const.Create_32bit(mtype.size));
 | 
						||
    end;
 | 
						||
  list.Concat(Tai_const.Create_32bit(items.count));
 | 
						||
  for i:=0 to items.Count-1 do
 | 
						||
    begin
 | 
						||
      m:=tprocdef(items[i]);
 | 
						||
      list.Concat(Tai_const.Create_sym(
 | 
						||
        objcreatestringpoolentry(m.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names)));
 | 
						||
      list.Concat(Tai_const.Create_sym(
 | 
						||
        objcreatestringpoolentry(objcencodemethod(m),sp_objcvartypes,sec_objc_meth_var_types)));
 | 
						||
      { placeholder for address of implementation? }
 | 
						||
      if (abi=oa_nonfragile) then
 | 
						||
        list.Concat(Tai_const.Create_pint(0));
 | 
						||
    end;
 | 
						||
end;
 | 
						||
 | 
						||
 | 
						||
{ Generate the rtti sections for all obj-c classes defined in st, and return
 | 
						||
  these classes in the classes list. }
 | 
						||
procedure tobjcrttiwriter.gen_objc_rtti_sections(list:TAsmList; st:TSymtable);
 | 
						||
  var
 | 
						||
    i: longint;
 | 
						||
    def: tdef;
 | 
						||
    sym : TAsmSymbol;
 | 
						||
  begin
 | 
						||
    if not Assigned(st) then
 | 
						||
      exit;
 | 
						||
 | 
						||
    for i:=0 to st.DefList.Count-1 do
 | 
						||
      begin
 | 
						||
        def:=tdef(st.DefList[i]);
 | 
						||
        { check whether all types used in Objective-C class/protocol/category
 | 
						||
          declarations can be used with the Objective-C run time (can only be
 | 
						||
          done now, because at parse-time some of these types can still be
 | 
						||
          forwarddefs) }
 | 
						||
        if is_objc_class_or_protocol(def) then
 | 
						||
          if not tobjectdef(def).check_objc_types then
 | 
						||
            continue;
 | 
						||
        if is_objcclass(def) and
 | 
						||
           not(oo_is_external in tobjectdef(def).objectoptions) then
 | 
						||
          begin
 | 
						||
            if not(oo_is_classhelper in tobjectdef(def).objectoptions) then
 | 
						||
              begin
 | 
						||
                gen_objc_classes_sections(list,tobjectdef(def),sym);
 | 
						||
                classsyms.add(sym);
 | 
						||
                classdefs.add(def);
 | 
						||
              end
 | 
						||
            else
 | 
						||
              begin
 | 
						||
                gen_objc_category_sections(list,tobjectdef(def),sym);
 | 
						||
                catsyms.add(sym);
 | 
						||
                catdefs.add(def);
 | 
						||
              end
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
constructor tobjcrttiwriter.create(_abi: tobjcabi);
 | 
						||
  begin
 | 
						||
    fabi:=_abi;
 | 
						||
    classdefs:=tfpobjectlist.create(false);
 | 
						||
    classsyms:=tfpobjectlist.create(false);
 | 
						||
    catdefs:=tfpobjectlist.create(false);
 | 
						||
    catsyms:=tfpobjectlist.create(false);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
destructor tobjcrttiwriter.destroy;
 | 
						||
  begin
 | 
						||
    classdefs.free;
 | 
						||
    classsyms.free;
 | 
						||
    catdefs.free;
 | 
						||
    catsyms.free;
 | 
						||
    inherited destroy;
 | 
						||
  end;
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                 RTTI generation -- Fragile ABI
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
{ generate an instance variables list for an obj-c class. }
 | 
						||
procedure tobjcrttiwriter_fragile.gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
 | 
						||
  type
 | 
						||
    ivar_data = record
 | 
						||
      vf      : tfieldvarsym;
 | 
						||
      namesym : TAsmSymbol;
 | 
						||
      typesym : TAsmSymbol;
 | 
						||
    end;
 | 
						||
  var
 | 
						||
    i     : integer;
 | 
						||
    vf    : tfieldvarsym;
 | 
						||
    vars  : array of ivar_data;
 | 
						||
    vcnt  : Integer;
 | 
						||
    enctype : ansistring;
 | 
						||
    encerr  : tdef;
 | 
						||
  begin
 | 
						||
    ivarslabel:=nil;
 | 
						||
 | 
						||
    vcnt:=0;
 | 
						||
    setLength(vars,objccls.symtable.SymList.Count);
 | 
						||
 | 
						||
    for i:=0 to objccls.symtable.SymList.Count-1 do
 | 
						||
      if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then
 | 
						||
        begin
 | 
						||
          vf:=tfieldvarsym(objccls.symtable.SymList[i]);
 | 
						||
          if objctryencodetype(vf.vardef,enctype,encerr) then
 | 
						||
            begin
 | 
						||
              vars[vcnt].vf:=vf;
 | 
						||
              vars[vcnt].namesym:=objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names);
 | 
						||
              vars[vcnt].typesym:=objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types);
 | 
						||
              inc(vcnt);
 | 
						||
            end
 | 
						||
          else
 | 
						||
            { Should be caught during parsing }
 | 
						||
            internalerror(2009090601);
 | 
						||
        end;
 | 
						||
    if vcnt=0 then
 | 
						||
      exit;
 | 
						||
 | 
						||
    new_section(list,sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint));
 | 
						||
 | 
						||
    current_asmdata.getlabel(ivarslabel,alt_data);
 | 
						||
    list.Concat(tai_label.Create(ivarslabel));
 | 
						||
 | 
						||
    { objc_ivar_list: first the number of elements }
 | 
						||
    list.Concat(tai_const.Create_32bit(vcnt));
 | 
						||
 | 
						||
    for i:=0 to vcnt-1 do
 | 
						||
      begin
 | 
						||
        { reference to the instance variable name }
 | 
						||
        list.Concat(tai_const.Create_sym(vars[i].namesym));
 | 
						||
        { reference to the encoded type }
 | 
						||
        list.Concat(tai_const.Create_sym(vars[i].typesym));
 | 
						||
        { and the offset of the field }
 | 
						||
        list.Concat(tai_const.Create_32bit(vars[i].vf.fieldoffset));
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
(* From GCC:
 | 
						||
 | 
						||
  struct _objc_protocol_extension
 | 
						||
    {
 | 
						||
      uint32_t size;	// sizeof (struct _objc_protocol_extension)
 | 
						||
      struct objc_method_list	*optional_instance_methods;
 | 
						||
      struct objc_method_list   *optional_class_methods;
 | 
						||
      struct objc_prop_list	*instance_properties;
 | 
						||
    }
 | 
						||
*)
 | 
						||
function tobjcrttiwriter_fragile.gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel;
 | 
						||
  begin
 | 
						||
    if assigned(optinstsym) or
 | 
						||
       assigned(optclssym) then
 | 
						||
      begin
 | 
						||
        new_section(list, sec_objc_protocol_ext,'_OBJC_PROTOCOLEXT',sizeof(pint));
 | 
						||
        current_asmdata.getlabel(Result,alt_data);
 | 
						||
        list.Concat(tai_label.Create(Result));
 | 
						||
        { size of this structure }
 | 
						||
        list.Concat(Tai_const.Create_32bit(16));
 | 
						||
        { optional instance methods }
 | 
						||
        ConcatSymOrNil(list,optinstsym);
 | 
						||
        { optional class methods }
 | 
						||
        ConcatSymOrNil(list,optclssym);
 | 
						||
        { optional properties (todo) }
 | 
						||
        ConcatSymOrNil(list,nil);
 | 
						||
      end
 | 
						||
    else
 | 
						||
      Result:=nil;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{ Generate rtti for an Objective-C protocol  }
 | 
						||
procedure tobjcrttiwriter_fragile.gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);
 | 
						||
  var
 | 
						||
    namesym     : TAsmSymbol;
 | 
						||
    protolist   : TAsmLabel;
 | 
						||
    reqinstsym,
 | 
						||
    optinstsym,
 | 
						||
    reqclssym,
 | 
						||
    optclssym,
 | 
						||
    protoext,
 | 
						||
    lbl          : TAsmLabel;
 | 
						||
  begin
 | 
						||
    gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist);
 | 
						||
    gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym);
 | 
						||
    protoext:=gen_objc_protocol_ext(list,optinstsym,optclssym);
 | 
						||
 | 
						||
    new_section(list, sec_objc_protocol,'_OBJC_PROTOCOL',sizeof(pint));
 | 
						||
    current_asmdata.getlabel(lbl,alt_data);
 | 
						||
    list.Concat(tai_label.Create(lbl));
 | 
						||
    protocollabel:=lbl;
 | 
						||
 | 
						||
    { protocol's isa - points to information about optional methods/properties }
 | 
						||
    ConcatSymOrNil(list,protoext);
 | 
						||
    { name }
 | 
						||
    namesym:=objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
    list.Concat(Tai_const.Create_sym(namesym));
 | 
						||
    { protocol's list }
 | 
						||
    ConcatSymOrNil(list,protolist);
 | 
						||
    { instance methods, in __cat_inst_meth }
 | 
						||
    ConcatSymOrNil(list,reqinstsym);
 | 
						||
    { class methods, in __cat_cls_meth }
 | 
						||
    ConcatSymOrNil(list,reqclssym);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
 | 
						||
  struct _objc_category {
 | 
						||
  char *category_name;
 | 
						||
  char *class_name;
 | 
						||
  struct _objc_method_list *instance_methods;
 | 
						||
  struct _objc_method_list *class_methods;
 | 
						||
  struct _objc_protocol_list *protocols;
 | 
						||
  uint32_t size; // <rdar://4585769>
 | 
						||
  struct _objc_property_list *instance_properties;
 | 
						||
  };
 | 
						||
*)
 | 
						||
 | 
						||
{ Generate rtti for an Objective-C class and its meta-class. }
 | 
						||
procedure tobjcrttiwriter_fragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);
 | 
						||
  var
 | 
						||
    instmthdlist,
 | 
						||
    clsmthdlist,
 | 
						||
    protolistsym  : TAsmLabel;
 | 
						||
    catstrsym,
 | 
						||
    clsstrsym,
 | 
						||
    catsym        : TAsmSymbol;
 | 
						||
  begin
 | 
						||
    { the category name }
 | 
						||
    catstrsym:=objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
 | 
						||
    { the name of the class it extends }
 | 
						||
    clsstrsym:=objcreatestringpoolentry(objccat.childof.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
 | 
						||
    { generate the methods lists }
 | 
						||
    gen_objc_methods(list,objccat,instmthdlist,false,true);
 | 
						||
    gen_objc_methods(list,objccat,clsmthdlist,true,true);
 | 
						||
 | 
						||
    { generate implemented protocols list }
 | 
						||
    gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym);
 | 
						||
 | 
						||
    { category declaration section }
 | 
						||
    new_section(list,sec_objc_category,'_OBJC_CATEGORY',sizeof(pint));
 | 
						||
    catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA);
 | 
						||
    list.Concat(tai_symbol.Create(catsym,0));
 | 
						||
 | 
						||
    list.Concat(Tai_const.Create_sym(catstrsym));
 | 
						||
    list.Concat(Tai_const.Create_sym(clsstrsym));
 | 
						||
    ConcatSymOrNil(list,instmthdlist);
 | 
						||
    ConcatSymOrNil(list,clsmthdlist);
 | 
						||
    ConcatSymOrNil(list,protolistsym);
 | 
						||
    { size of this structure }
 | 
						||
    list.Concat(Tai_const.Create_32bit(28));
 | 
						||
    { properties, not yet supported }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
 | 
						||
    catlabel:=catsym;
 | 
						||
  end;
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
 | 
						||
  struct _objc_class {
 | 
						||
    Class isa;
 | 
						||
    Class super_class;
 | 
						||
    const char *name;
 | 
						||
    long version;
 | 
						||
    long info;
 | 
						||
    long instance_size;
 | 
						||
    struct _objc_ivar_list *ivars;
 | 
						||
    struct _objc_method_list *methods;
 | 
						||
    struct _objc_cache *cache;
 | 
						||
    struct _objc_protocol_list *protocols;
 | 
						||
    // Objective-C 1.0 extensions (<rdr://4585769>) -- for garbage collection
 | 
						||
    const char *ivar_layout;
 | 
						||
    struct _objc_class_ext *ext;
 | 
						||
  };
 | 
						||
*)
 | 
						||
 | 
						||
 | 
						||
 | 
						||
{ Generate rtti for an Objective-C class and its meta-class. }
 | 
						||
procedure tobjcrttiwriter_fragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);
 | 
						||
  const
 | 
						||
    CLS_CLASS  = 1;
 | 
						||
    CLS_META   = 2;
 | 
						||
    CLS_HIDDEN = $20000;
 | 
						||
    META_INST_SIZE = 40+8; // sizeof(objc_class) + 8
 | 
						||
  var
 | 
						||
    root          : tobjectdef;
 | 
						||
    superStrSym,
 | 
						||
    classStrSym,
 | 
						||
    metaisaStrSym,
 | 
						||
    metasym,
 | 
						||
    clssym        : TAsmSymbol;
 | 
						||
    mthdlist,
 | 
						||
    ivarslist,
 | 
						||
    protolistsym  : TAsmLabel;
 | 
						||
    hiddenflag    : cardinal;
 | 
						||
  begin
 | 
						||
    { generate the class methods list }
 | 
						||
    gen_objc_methods(list,objclss,mthdlist,true,false);
 | 
						||
 | 
						||
    { generate implemented protocols list }
 | 
						||
    gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym);
 | 
						||
 | 
						||
    { register necessary names }
 | 
						||
    { 1) the superclass }
 | 
						||
    if assigned(objclss.childof) then
 | 
						||
      superStrSym:=objcreatestringpoolentry(objclss.childof.objextname^,sp_objcclassnames,sec_objc_class_names)
 | 
						||
    else
 | 
						||
      { not empty string, but nil! }
 | 
						||
      superStrSym:=nil;
 | 
						||
 | 
						||
    { 2) the current class }
 | 
						||
    classStrSym:=objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
    { 3) the isa }
 | 
						||
    { From Clang: The isa for the meta-class is the root of the hierarchy. }
 | 
						||
    root:=objclss;
 | 
						||
    while assigned(root.childof) do
 | 
						||
      root:=root.childof;
 | 
						||
    metaisaStrSym:=objcreatestringpoolentry(root.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
 | 
						||
    { 4) the flags }
 | 
						||
    { consider every class declared in the implementation section of a unit
 | 
						||
      as "hidden"
 | 
						||
    }
 | 
						||
    hiddenflag:=0;
 | 
						||
    if (objclss.owner.symtabletype=staticsymtable) and
 | 
						||
       current_module.is_unit then
 | 
						||
      hiddenflag:=CLS_HIDDEN;
 | 
						||
 | 
						||
    { class declaration section }
 | 
						||
    new_section(list,sec_objc_meta_class,'_OBJC_META_CLASS',sizeof(pint));
 | 
						||
 | 
						||
    { 1) meta-class declaration  }
 | 
						||
    metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),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 }
 | 
						||
    if assigned(superstrsym) then
 | 
						||
      list.Concat(Tai_const.Create_sym(superStrSym))
 | 
						||
    else
 | 
						||
      list.concat(tai_const.create_32bit(0));
 | 
						||
    { pointer to the class name }
 | 
						||
    list.Concat(Tai_const.Create_sym(classStrSym));
 | 
						||
 | 
						||
    { version is always 0 currently }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { CLS_META for meta-classes }
 | 
						||
    list.Concat(Tai_const.Create_32bit(hiddenflag or CLS_META));
 | 
						||
    { size of the meta-class instance: sizeof(objc_class) + 8 bytes }
 | 
						||
    list.Concat(Tai_const.Create_32bit(META_INST_SIZE) );
 | 
						||
    { meta-classes don't have ivars list (=0) }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { class methods list (stored in "__cls_meth" section) }
 | 
						||
    if Assigned(mthdlist) then
 | 
						||
      list.Concat(Tai_const.Create_sym(mthdlist))
 | 
						||
    else
 | 
						||
      list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { From Clang: cache is always nil }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { protocols }
 | 
						||
    ConcatSymOrNil(list, protolistsym);
 | 
						||
    { From Clang: ivar_layout for meta-class is always NULL. }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { From Clang: The class extension is always unused for meta-classes. }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
 | 
						||
    { 2) regular class declaration }
 | 
						||
 | 
						||
    { generate the instance methods list }
 | 
						||
    gen_objc_methods(list,objclss,mthdlist,false,false);
 | 
						||
    { generate the instance variables list }
 | 
						||
    gen_objc_ivars(list,objclss,ivarslist);
 | 
						||
 | 
						||
    new_section(list,sec_objc_class,'_OBJC_CLASS',sizeof(pint));
 | 
						||
 | 
						||
    clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA);
 | 
						||
    list.Concat(tai_symbol.Create(clssym,0));
 | 
						||
 | 
						||
    { for class declaration: the isa points to the meta-class declaration }
 | 
						||
    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))
 | 
						||
    else
 | 
						||
      list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { pointer to the class name }
 | 
						||
    list.Concat(Tai_const.Create_sym(classStrSym));
 | 
						||
    { version is always 0 currently }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { CLS_CLASS for classes }
 | 
						||
    list.Concat(Tai_const.Create_32bit(hiddenflag or CLS_CLASS));
 | 
						||
    { size of instance: total size of instance variables }
 | 
						||
    list.Concat(Tai_const.Create_32bit(tobjectsymtable(objclss.symtable).datasize));
 | 
						||
    { objc_ivar_list (stored in "__instance_vars" section) }
 | 
						||
    if assigned(ivarslist) then
 | 
						||
      list.Concat(Tai_const.Create_sym(ivarslist))
 | 
						||
    else
 | 
						||
      list.Concat(tai_const.create_32bit(0));
 | 
						||
    { instance methods list (stored in "__inst_meth" section) }
 | 
						||
    if Assigned(mthdlist) then
 | 
						||
      list.Concat(Tai_const.Create_sym(mthdlist))
 | 
						||
    else
 | 
						||
      list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { From Clang: cache is always NULL }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { protocols, protolistsym has been created for meta-class, no need to create another one}
 | 
						||
    ConcatSymOrNil(list, protolistsym);
 | 
						||
    { TODO: From Clang: strong ivar_layout, necessary for garbage collection support }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
    { TODO: From Clang: weak ivar_layout, necessary for garbage collection support }
 | 
						||
    list.Concat(Tai_const.Create_32bit(0));
 | 
						||
 | 
						||
    classlabel:=clssym;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{ Generate the global information sections (objc_symbols and objc_module_info)
 | 
						||
  for this module. }
 | 
						||
procedure tobjcrttiwriter_fragile.gen_objc_info_sections(list: tasmlist);
 | 
						||
  var
 | 
						||
    i: longint;
 | 
						||
    sym : TAsmSymbol;
 | 
						||
    parent: tobjectdef;
 | 
						||
    superclasses: tfpobjectlist;
 | 
						||
  begin
 | 
						||
    if (classsyms.count<>0) or
 | 
						||
       (catsyms.count<>0) then
 | 
						||
      begin
 | 
						||
        new_section(list,sec_objc_symbols,'_OBJC_SYMBOLS',sizeof(pint));
 | 
						||
        sym := current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_SYMBOLS_$',AB_LOCAL,AT_DATA);
 | 
						||
 | 
						||
        { symbol to refer to this information }
 | 
						||
        list.Concat(tai_symbol.Create(sym,0));
 | 
						||
        { ??? (always 0 in Clang) }
 | 
						||
        list.Concat(Tai_const.Create_pint(0));
 | 
						||
        { ??? (From Clang: always 0, pointer to some selector) }
 | 
						||
        list.Concat(Tai_const.Create_pint(0));
 | 
						||
        { From Clang: number of defined classes }
 | 
						||
        list.Concat(Tai_const.Create_16bit(classsyms.count));
 | 
						||
        { From Clang: number of defined categories }
 | 
						||
        list.Concat(Tai_const.Create_16bit(catsyms.count));
 | 
						||
        { first all classes }
 | 
						||
        for i:=0 to classsyms.count-1 do
 | 
						||
          list.Concat(Tai_const.Create_sym(tasmsymbol(classsyms[i])));
 | 
						||
        { then all categories }
 | 
						||
        for i:=0 to catsyms.count-1 do
 | 
						||
          list.Concat(Tai_const.Create_sym(tasmsymbol(catsyms[i])));
 | 
						||
     end
 | 
						||
    else
 | 
						||
      sym:=nil;
 | 
						||
 | 
						||
    new_section(list,sec_objc_module_info,'_OBJC_MODULE_INFO',4);
 | 
						||
    { version number = 7 (always, both for gcc and clang) }
 | 
						||
    list.Concat(Tai_const.Create_pint(7));
 | 
						||
    { sizeof(objc_module): 4 pointer-size entities }
 | 
						||
    list.Concat(Tai_const.Create_pint(sizeof(pint)*4));
 | 
						||
    { used to be file name, now unused (points to empty string) }
 | 
						||
    list.Concat(Tai_const.Create_sym(objcreatestringpoolentry('',sp_objcclassnames,sec_objc_class_names)));
 | 
						||
    { pointer to classes/categories list declared in this module }
 | 
						||
    if assigned(sym) then
 | 
						||
      list.Concat(Tai_const.Create_sym(sym))
 | 
						||
    else
 | 
						||
      list.concat(tai_const.create_pint(0));
 | 
						||
 | 
						||
    { Add lazy references to parent classes of all classes defined in this unit }
 | 
						||
    superclasses:=tfpobjectlist.create(false);
 | 
						||
    for i:=0 to classdefs.count-1 do
 | 
						||
      begin
 | 
						||
        parent:=tobjectdef(classdefs[i]).childof;
 | 
						||
        { warning: linear search, performance hazard if large number of subclasses }
 | 
						||
        if assigned(parent) and
 | 
						||
           (superclasses.indexof(parent)=-1) then
 | 
						||
          begin
 | 
						||
            list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^));
 | 
						||
            superclasses.add(parent);
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
    for i:=0 to catdefs.count-1 do
 | 
						||
      begin
 | 
						||
        parent:=tobjectdef(catdefs[i]).childof;
 | 
						||
        { warning: linear search, performance hazard if large number of subclasses }
 | 
						||
        if assigned(parent) and
 | 
						||
           (superclasses.indexof(parent)=-1) then
 | 
						||
          begin
 | 
						||
            list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^));
 | 
						||
            superclasses.add(parent);
 | 
						||
          end;
 | 
						||
      end;
 | 
						||
    superclasses.free;
 | 
						||
    { reference symbols for all classes and categories defined in this unit }
 | 
						||
    for i:=0 to classdefs.count-1 do
 | 
						||
      list.concat(tai_symbol.Createname_global_value('.objc_class_name_'+tobjectdef(classdefs[i]).objextname^,AT_DATA,0,0));
 | 
						||
    for i:=0 to catdefs.count-1 do
 | 
						||
      list.concat(tai_symbol.Createname_global_value('.objc_category_name_'+
 | 
						||
        tobjectdef(catdefs[i]).childof.objextname^+'_'+
 | 
						||
        tobjectdef(catdefs[i]).objextname^,AT_DATA,0,0));
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
constructor tobjcrttiwriter_fragile.create;
 | 
						||
  begin
 | 
						||
    inherited create(oa_fragile);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                 RTTI generation -- Non-Fragile ABI
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
/// EmitIvarList - Emit the ivar list for the given
 | 
						||
/// implementation. The return value has type
 | 
						||
/// IvarListnfABIPtrTy.
 | 
						||
///  struct _ivar_t {
 | 
						||
///   unsigned long int *offset;  // pointer to ivar offset location
 | 
						||
///   char *name;
 | 
						||
///   char *type;
 | 
						||
///   uint32_t alignment;
 | 
						||
///   uint32_t size;
 | 
						||
/// }
 | 
						||
/// struct _ivar_list_t {
 | 
						||
///   uint32 entsize;  // sizeof(struct _ivar_t)
 | 
						||
///   uint32 count;
 | 
						||
///   struct _iver_t list[count];
 | 
						||
/// }
 | 
						||
///
 | 
						||
*)
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_ivars(list: tasmlist; objccls: tobjectdef; out ivarslabel: tasmlabel);
 | 
						||
  type
 | 
						||
    ivar_data = record
 | 
						||
      vf      : tfieldvarsym;
 | 
						||
      namesym : TAsmSymbol;
 | 
						||
      typesym : TAsmSymbol;
 | 
						||
      offssym : TAsmSymbol;
 | 
						||
    end;
 | 
						||
  var
 | 
						||
    ivtype: tdef;
 | 
						||
    vf    : tfieldvarsym;
 | 
						||
    vars  : array of ivar_data;
 | 
						||
    i     : integer;
 | 
						||
    vcnt  : integer;
 | 
						||
    enctype : ansistring;
 | 
						||
    encerr  : tdef;
 | 
						||
    prefix  : shortstring;
 | 
						||
    vis     : TAsmsymbind;
 | 
						||
  begin
 | 
						||
    ivarslabel:=nil;
 | 
						||
 | 
						||
    vcnt:=0;
 | 
						||
    setLength(vars,objccls.symtable.SymList.Count);
 | 
						||
 | 
						||
    for i:=0 to objccls.symtable.SymList.Count-1 do
 | 
						||
      if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then
 | 
						||
        begin
 | 
						||
          vf:=tfieldvarsym(objccls.symtable.SymList[i]);
 | 
						||
          if objctryencodetype(vf.vardef,enctype,encerr) then
 | 
						||
            begin
 | 
						||
              vars[vcnt].vf:=vf;
 | 
						||
              vars[vcnt].namesym:=objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names);
 | 
						||
              vars[vcnt].typesym:=objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types);
 | 
						||
              if (vcnt=0) then
 | 
						||
                begin
 | 
						||
                  new_section(list,sec_objc_const,'_OBJC_IVAR_OFFSETS',sizeof(pint));
 | 
						||
                  prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.';
 | 
						||
                end;
 | 
						||
              { This matches gcc/Clang, but is strange: I would expect private
 | 
						||
                fields to be local symbols rather than private_extern (which
 | 
						||
                is "package-global") (JM)
 | 
						||
              }
 | 
						||
              if not(vf.visibility in [vis_public,vis_protected,vis_strictprotected]) then
 | 
						||
                vis:=AB_PRIVATE_EXTERN
 | 
						||
              else
 | 
						||
                vis:=AB_GLOBAL;
 | 
						||
              vars[vcnt].offssym:=current_asmdata.DefineAsmSymbol(prefix+vf.RealName,vis,AT_DATA);
 | 
						||
              list.concat(tai_symbol.Create_Global(vars[vcnt].offssym,0));
 | 
						||
              list.concat(tai_const.create_pint(vf.fieldoffset));
 | 
						||
              inc(vcnt);
 | 
						||
            end
 | 
						||
          else
 | 
						||
            { must be caught during parsing }
 | 
						||
            internalerror(2009092301);
 | 
						||
        end;
 | 
						||
    if vcnt=0 then
 | 
						||
      exit;
 | 
						||
 | 
						||
    new_section(list,sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint));
 | 
						||
 | 
						||
    current_asmdata.getlabel(ivarslabel,alt_data);
 | 
						||
    list.Concat(tai_label.Create(ivarslabel));
 | 
						||
 | 
						||
    { size of each entry -- always 32 bit value }
 | 
						||
    ivtype:=search_named_unit_globaltype('OBJC','OBJC_IVAR',true).typedef;
 | 
						||
    list.concat(tai_const.Create_32bit(ivtype.size));
 | 
						||
    { number of entries -- always 32 bit value }
 | 
						||
    list.Concat(tai_const.Create_32bit(vcnt));
 | 
						||
 | 
						||
    for i:=0 to vcnt-1 do
 | 
						||
      begin
 | 
						||
        { reference to the offset }
 | 
						||
        list.Concat(tai_const.Create_sym(vars[i].offssym));
 | 
						||
        { reference to the instance variable name }
 | 
						||
        list.Concat(tai_const.Create_sym(vars[i].namesym));
 | 
						||
        { reference to the encoded type }
 | 
						||
        list.Concat(tai_const.Create_sym(vars[i].typesym));
 | 
						||
        { alignment -- always 32 bit value }
 | 
						||
        list.Concat(tai_const.create_32bit(vars[i].vf.vardef.alignment));
 | 
						||
        { size -- always 32 bit value }
 | 
						||
        list.Concat(tai_const.Create_32bit(vars[i].vf.vardef.size));
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
/// GetOrEmitProtocol - Generate the protocol meta-data:
 | 
						||
/// @code
 | 
						||
/// struct _protocol_t {
 | 
						||
///   id isa;  // NULL
 | 
						||
///   const char * const protocol_name;
 | 
						||
///   const struct _protocol_list_t * protocol_list; // super protocols
 | 
						||
///   const struct method_list_t * const instance_methods;
 | 
						||
///   const struct method_list_t * const class_methods;
 | 
						||
///   const struct method_list_t *optionalInstanceMethods;
 | 
						||
///   const struct method_list_t *optionalClassMethods;
 | 
						||
///   const struct _prop_list_t * properties;
 | 
						||
///   const uint32_t size;  // sizeof(struct _protocol_t)
 | 
						||
///   const uint32_t flags;  // = 0
 | 
						||
/// }
 | 
						||
/// @endcode
 | 
						||
*)
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_protocol(list: tasmlist; protocol: tobjectdef; out protocollabel: tasmsymbol);
 | 
						||
  var
 | 
						||
    lbl,
 | 
						||
    namesym,
 | 
						||
    listsym       : TAsmSymbol;
 | 
						||
    protolist     : TAsmLabel;
 | 
						||
    reqinstsym,
 | 
						||
    reqclssym,
 | 
						||
    optinstsym,
 | 
						||
    optclssym     : TAsmLabel;
 | 
						||
    prottype      : tdef;
 | 
						||
  begin
 | 
						||
    gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist);
 | 
						||
    gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym);
 | 
						||
 | 
						||
    new_section(list, sec_data_coalesced,'_OBJC_PROTOCOL',sizeof(pint));
 | 
						||
    { label for the protocol needs to be
 | 
						||
        a) in a coalesced section (so multiple definitions of the same protocol
 | 
						||
           can be merged by the linker)
 | 
						||
        b) private_extern (should only be merged within the same module)
 | 
						||
        c) weakly defined (so multiple definitions don't cause errors)
 | 
						||
    }
 | 
						||
    lbl:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcclassrtti),AB_PRIVATE_EXTERN,AT_DATA);
 | 
						||
    list.Concat(tai_symbol.Create_Global(lbl,0));
 | 
						||
    list.Concat(tai_directive.Create(asd_weak_definition,lbl.name));
 | 
						||
    protocollabel:=lbl;
 | 
						||
 | 
						||
    { protocol's isa - always nil }
 | 
						||
    list.Concat(Tai_const.Create_pint(0));
 | 
						||
    { name }
 | 
						||
    namesym:=objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
    list.Concat(Tai_const.Create_sym(namesym));
 | 
						||
    { parent protocols list }
 | 
						||
    ConcatSymOrNil(list,protolist);
 | 
						||
    { required instance methods }
 | 
						||
    ConcatSymOrNil(list,reqinstsym);
 | 
						||
    { required class methods }
 | 
						||
    ConcatSymOrNil(list,reqclssym);
 | 
						||
    { optional instance methods }
 | 
						||
    ConcatSymOrNil(list,optinstsym);
 | 
						||
    { optional class methods }
 | 
						||
    ConcatSymOrNil(list,optclssym);
 | 
						||
    { TODO: properties }
 | 
						||
    list.Concat(Tai_const.Create_pint(0));
 | 
						||
    { size of this type }
 | 
						||
    prottype:=search_named_unit_globaltype('OBJC','OBJC_PROTOCOL',true).typedef;
 | 
						||
    list.concat(tai_const.Create_32bit(prottype.size));
 | 
						||
    { flags }
 | 
						||
    list.concat(tai_const.Create_32bit(0));
 | 
						||
 | 
						||
    { also add an entry to the __DATA, __objc_protolist section, required to
 | 
						||
      register the protocol with the runtime }
 | 
						||
    new_section(list, sec_objc_protolist,'_OBJC_PROTOLIST',sizeof(pint));
 | 
						||
    listsym:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcmetartti),AB_PRIVATE_EXTERN,AT_DATA);
 | 
						||
    list.Concat(tai_symbol.Create_Global(listsym,0));
 | 
						||
    list.Concat(tai_const.Create_sym(lbl));
 | 
						||
    list.Concat(tai_directive.Create(asd_weak_definition,listsym.name));
 | 
						||
  end;
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
/// struct _category_t {
 | 
						||
///   const char * const name;
 | 
						||
///   struct _class_t *const cls;
 | 
						||
///   const struct _method_list_t * const instance_methods;
 | 
						||
///   const struct _method_list_t * const class_methods;
 | 
						||
///   const struct _protocol_list_t * const protocols;
 | 
						||
///   const struct _prop_list_t * const properties;
 | 
						||
/// }
 | 
						||
*)
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);
 | 
						||
  var
 | 
						||
    instmthdlist,
 | 
						||
    clsmthdlist,
 | 
						||
    protolistsym  : TAsmLabel;
 | 
						||
    catstrsym,
 | 
						||
    clssym,
 | 
						||
    catsym        : TAsmSymbol;
 | 
						||
  begin
 | 
						||
    { the category name }
 | 
						||
    catstrsym:=objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
 | 
						||
    { the class it extends }
 | 
						||
    clssym:=current_asmdata.RefAsmSymbol(objccat.childof.rtti_mangledname(objcclassrtti));
 | 
						||
 | 
						||
    { generate the methods lists }
 | 
						||
    gen_objc_methods(list,objccat,instmthdlist,false,true);
 | 
						||
    gen_objc_methods(list,objccat,clsmthdlist,true,true);
 | 
						||
 | 
						||
    { generate implemented protocols list }
 | 
						||
    gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym);
 | 
						||
 | 
						||
    { category declaration section }
 | 
						||
    new_section(list,sec_objc_const,'_OBJC_CATEGORY',sizeof(pint));
 | 
						||
    catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA);
 | 
						||
    list.Concat(tai_symbol.Create(catsym,0));
 | 
						||
 | 
						||
    list.Concat(Tai_const.Create_sym(catstrsym));
 | 
						||
    list.Concat(Tai_const.Create_sym(clssym));
 | 
						||
    ConcatSymOrNil(list,instmthdlist);
 | 
						||
    ConcatSymOrNil(list,clsmthdlist);
 | 
						||
    ConcatSymOrNil(list,protolistsym);
 | 
						||
    { properties, not yet supported }
 | 
						||
    list.Concat(Tai_const.Create_pint(0));
 | 
						||
 | 
						||
    catlabel:=catsym;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
/// BuildIvarLayout - Builds ivar layout bitmap for the class
 | 
						||
/// implementation for the __strong or __weak case.
 | 
						||
/// The layout map displays which words in ivar list must be skipped
 | 
						||
/// and which must be scanned by GC (see below). String is built of bytes.
 | 
						||
/// Each byte is divided up in two nibbles (4-bit each). Left nibble is count
 | 
						||
/// of words to skip and right nibble is count of words to scan. So, each
 | 
						||
/// nibble represents up to 15 workds to skip or scan. Skipping the rest is
 | 
						||
/// represented by a 0x00 byte which also ends the string.
 | 
						||
/// 1. when ForStrongLayout is true, following ivars are scanned:
 | 
						||
/// - id, Class
 | 
						||
/// - object *  // note: this "object" means "Objective-C object" (JM)
 | 
						||
/// - __strong anything
 | 
						||
///
 | 
						||
/// 2. When ForStrongLayout is false, following ivars are scanned:
 | 
						||
/// - __weak anything
 | 
						||
*)
 | 
						||
(*
 | 
						||
 | 
						||
Only required when supporting garbage collection
 | 
						||
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_ivargc_recursive(st: tabstractrecordsymtable; ptrbset: tbitset; startoffset: puint; il: tivarlayouttype);
 | 
						||
var
 | 
						||
  i: longint;
 | 
						||
  fs: tfieldvarsym;
 | 
						||
  includelen: longint;
 | 
						||
begin
 | 
						||
  for i:=0 to st.SymList.count-1 do
 | 
						||
    if (tsym(st.symlist[i]).typ=fieldvarsym) then
 | 
						||
      begin
 | 
						||
        fs:=tfieldvarsym(st.symlist[i]);
 | 
						||
        includelen:=0;
 | 
						||
        case fs.vardef.typ of
 | 
						||
          pointerdef,
 | 
						||
          classrefdef:
 | 
						||
            if (fs.vardef=objc_idtype) or
 | 
						||
               (fs.vardef=objc_metaclasstype) then
 | 
						||
              includelen:=1;
 | 
						||
          recorddef:
 | 
						||
            TODO: bitpacking -> offset differences
 | 
						||
            gen_objc_ivargc_recursive(tabstractrecordsymtable(trecorddef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il);
 | 
						||
          arraydef:
 | 
						||
            begin
 | 
						||
              if not is_special_
 | 
						||
            end;
 | 
						||
          objectdef :
 | 
						||
            begin
 | 
						||
              case tobjectdef(fs.vardef).objecttype of
 | 
						||
                odt_objcclass,
 | 
						||
                odt_objcprotocol:
 | 
						||
                  includelen:=1;
 | 
						||
                odt_object:
 | 
						||
                  gen_objc_ivargc_recursive(tabstractrecordsymtable(tobjectdef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il);
 | 
						||
              end;
 | 
						||
            end;
 | 
						||
        end;
 | 
						||
      end;
 | 
						||
end;
 | 
						||
 | 
						||
 | 
						||
function tobjcrttiwriter_nonfragile.gen_objc_ivargcstring(objclss: tobjectdef; il: tivarlayouttype): ansistring;
 | 
						||
  var
 | 
						||
    ptrbset: tbitset;
 | 
						||
    parent: tobjectdef;
 | 
						||
    size,
 | 
						||
    startoffset: puint;
 | 
						||
    i: longint;
 | 
						||
  begin
 | 
						||
    size:=tObjectSymtable(objclss.symtable).datasize;
 | 
						||
    if assigned(objclss.childof) then
 | 
						||
      startoffset:=tObjectSymtable(objclss.childof.symtable).datasize
 | 
						||
    else
 | 
						||
      startoffset:=0;
 | 
						||
    size:=size-startoffset;
 | 
						||
    ptrbset:=tbitset.create_bytesize((size+sizeof(ptruint)-1) div sizeof(ptruint));
 | 
						||
    { has to include info for this class' fields and those of all parent
 | 
						||
      classes as well
 | 
						||
    }
 | 
						||
    parent:=obclss;
 | 
						||
    repeat
 | 
						||
      gen_objc_ivargc_recursive(parent.symtable,ptrbset,0,il);
 | 
						||
      parent:=parent.childof;
 | 
						||
    until not assigned(parent);
 | 
						||
    { convert bits set to encoded string }
 | 
						||
  end;
 | 
						||
*)
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
/// struct _class_ro_t {
 | 
						||
///   uint32_t const flags;
 | 
						||
///   uint32_t const instanceStart;
 | 
						||
///   uint32_t const instanceSize;
 | 
						||
///   uint32_t const reserved;  // only when building for 64bit targets
 | 
						||
///   const uint8_t * const ivarLayout;
 | 
						||
///   const char *const name;
 | 
						||
///   const struct _method_list_t * const baseMethods;
 | 
						||
///   const struct _protocol_list_t *const baseProtocols;
 | 
						||
///   const struct _ivar_list_t *const ivars;
 | 
						||
///   const uint8_t * const weakIvarLayout;
 | 
						||
///   const struct _prop_list_t * const properties;
 | 
						||
/// }
 | 
						||
*)
 | 
						||
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_class_ro_part(list: tasmlist; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: tasmsymbol; metaclass: boolean);
 | 
						||
  const
 | 
						||
    CLS_CLASS        = 0;
 | 
						||
    CLS_META         = 1;
 | 
						||
    CLS_ROOT         = 2;
 | 
						||
    OBJC2_CLS_HIDDEN = $10;
 | 
						||
    CLS_EXCEPTION    = $20;
 | 
						||
  var
 | 
						||
    classStrSym,
 | 
						||
    rosym        : TAsmSymbol;
 | 
						||
    methodslab,
 | 
						||
    ivarslab     : TAsmLabel;
 | 
						||
    class_type   : tdef;
 | 
						||
    start,
 | 
						||
    size,
 | 
						||
    flags        : cardinal;
 | 
						||
    rttitype     : trttitype;
 | 
						||
    firstfield   : tfieldvarsym;
 | 
						||
    i            : longint;
 | 
						||
  begin
 | 
						||
    { consider every class declared in the implementation section of a unit
 | 
						||
      as "hidden"
 | 
						||
    }
 | 
						||
    flags:=0;
 | 
						||
    if (objclss.owner.symtabletype=staticsymtable) and
 | 
						||
       current_module.is_unit then
 | 
						||
      flags:=OBJC2_CLS_HIDDEN;
 | 
						||
    if metaclass then
 | 
						||
      begin
 | 
						||
        flags:=flags or CLS_META;
 | 
						||
        rttitype:=objcmetarortti;
 | 
						||
        { metaclass size/start: always size of objc_object }
 | 
						||
        class_type:=search_named_unit_globaltype('OBJC','OBJC_OBJECT',true).typedef;
 | 
						||
        start:=class_type.size;
 | 
						||
        size:=start;
 | 
						||
      end
 | 
						||
    else
 | 
						||
      begin
 | 
						||
        flags:=flags or CLS_CLASS;
 | 
						||
        rttitype:=objcclassrortti;
 | 
						||
        size:=tObjectSymtable(objclss.symtable).datasize;
 | 
						||
        { can't simply use childof's datasize, because alignment may cause the
 | 
						||
          first field to skip a couple of bytes after the previous end }
 | 
						||
        firstfield:=nil;
 | 
						||
        for i:=0 to objclss.symtable.SymList.Count-1 do
 | 
						||
          if (tsym(objclss.symtable.SymList[i]).typ=fieldvarsym) then
 | 
						||
            begin
 | 
						||
              firstfield:=tfieldvarsym(objclss.symtable.SymList[i]);
 | 
						||
              break;
 | 
						||
            end;
 | 
						||
        if assigned(firstfield) then
 | 
						||
          start:=firstfield.fieldoffset
 | 
						||
        else
 | 
						||
          { no extra fields -> start = size }
 | 
						||
          start:=size;
 | 
						||
      end;
 | 
						||
    if not assigned(objclss.childof) then
 | 
						||
      flags:=flags or CLS_ROOT;
 | 
						||
 | 
						||
    classStrSym:=objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names);
 | 
						||
    { generate methods list }
 | 
						||
    gen_objc_methods(list,objclss,methodslab,metaclass,false);
 | 
						||
    { generate ivars (nil for metaclass) }
 | 
						||
    if metaclass then
 | 
						||
      ivarslab:=nil
 | 
						||
    else
 | 
						||
      gen_objc_ivars(list,objclss,ivarslab);
 | 
						||
 | 
						||
    { class declaration section }
 | 
						||
    new_section(list,sec_objc_const,'_OBJC_META_CLASS',sizeof(pint));
 | 
						||
 | 
						||
    rosym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(rttitype),AB_LOCAL,AT_DATA);
 | 
						||
    classrolabel:=rosym;
 | 
						||
    list.Concat(tai_symbol.create(rosym,0));
 | 
						||
    list.Concat(tai_const.Create_32bit(longint(flags)));
 | 
						||
    list.Concat(tai_const.Create_32bit(longint(start)));
 | 
						||
    list.Concat(tai_const.Create_32bit(longint(size)));
 | 
						||
{$ifdef cpu64bitaddr}
 | 
						||
    { alignment }
 | 
						||
    list.Concat(tai_const.Create_32bit(0));
 | 
						||
{$endif}
 | 
						||
    { TODO: strong ivar layout for garbage collection }
 | 
						||
    list.concat(tai_const.Create_pint(0));
 | 
						||
    list.concat(tai_const.Create_sym(classStrSym));
 | 
						||
    ConcatSymOrNil(list,methodslab);
 | 
						||
    ConcatSymOrNil(list,protolistsym);
 | 
						||
    ConcatSymOrNil(list,ivarslab);
 | 
						||
    { TODO: weak ivar layout for garbage collection }
 | 
						||
    list.concat(tai_const.Create_pint(0));
 | 
						||
    { TODO: properties }
 | 
						||
    list.concat(tai_const.Create_pint(0));
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
(*
 | 
						||
From Clang:
 | 
						||
 | 
						||
/// struct _class_t {
 | 
						||
///   struct _class_t *isa;
 | 
						||
///   struct _class_t * const superclass;
 | 
						||
///   void *cache;
 | 
						||
///   IMP *vtable;
 | 
						||
///   struct class_ro_t *ro;
 | 
						||
/// }
 | 
						||
///
 | 
						||
*)
 | 
						||
 | 
						||
{ Generate rtti for an Objective-C class and its meta-class. }
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);
 | 
						||
  var
 | 
						||
    root          : tobjectdef;
 | 
						||
    superSym,
 | 
						||
    superMetaSym,
 | 
						||
    metaisaSym,
 | 
						||
    metasym,
 | 
						||
    clssym,
 | 
						||
    metarosym,
 | 
						||
    rosym         : TAsmSymbol;
 | 
						||
    protolistsym  : TAsmLabel;
 | 
						||
    vis           : TAsmsymbind;
 | 
						||
  begin
 | 
						||
    { A) Register necessary names }
 | 
						||
 | 
						||
    { 1) the current class and metaclass }
 | 
						||
    if (objclss.owner.symtabletype=globalsymtable) then
 | 
						||
      vis:=AB_GLOBAL
 | 
						||
    else
 | 
						||
      vis:=AB_PRIVATE_EXTERN;
 | 
						||
    clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),vis,AT_DATA);
 | 
						||
    metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),vis,AT_DATA);
 | 
						||
    { 2) the superclass and meta superclass }
 | 
						||
    if assigned(objclss.childof) then
 | 
						||
      begin
 | 
						||
        superSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcclassrtti));
 | 
						||
        superMetaSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcmetartti));
 | 
						||
      end
 | 
						||
    else
 | 
						||
      begin
 | 
						||
        superSym:=nil;
 | 
						||
        { the class itself }
 | 
						||
        superMetaSym:=clssym;
 | 
						||
      end;
 | 
						||
 | 
						||
    { 3) the isa }
 | 
						||
    { From Clang: The isa for the meta-class is the root of the hierarchy. }
 | 
						||
    root:=objclss;
 | 
						||
    while assigned(root.childof) do
 | 
						||
      root:=root.childof;
 | 
						||
    metaisaSym:=current_asmdata.RefAsmSymbol(root.rtti_mangledname(objcmetartti));
 | 
						||
 | 
						||
    { 4) the implemented protocols (same for metaclass and regular class) }
 | 
						||
    gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym);
 | 
						||
 | 
						||
    { 5) the read-only parts of the class definitions }
 | 
						||
    gen_objc_class_ro_part(list,objclss,protolistsym,metarosym,true);
 | 
						||
    gen_objc_class_ro_part(list,objclss,protolistsym,rosym,false);
 | 
						||
 | 
						||
    { B) Class declaration section }
 | 
						||
    { both class and metaclass are in the objc_data section for obj-c 2 }
 | 
						||
    new_section(list,sec_objc_data,'_OBJC_CLASS',sizeof(pint));
 | 
						||
 | 
						||
    { 1) meta-class declaration }
 | 
						||
    list.Concat(tai_symbol.Create_Global(metasym,0));
 | 
						||
 | 
						||
    { the isa }
 | 
						||
    list.Concat(Tai_const.Create_sym(metaisaSym));
 | 
						||
    { the superclass }
 | 
						||
    list.Concat(Tai_const.Create_sym(superMetaSym));
 | 
						||
    { pointer to cache }
 | 
						||
    if not assigned(ObjCEmptyCacheVar) then
 | 
						||
      ObjCEmptyCacheVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_cache');
 | 
						||
    list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar));
 | 
						||
    { pointer to vtable }
 | 
						||
    if not assigned(ObjCEmptyVtableVar) then
 | 
						||
      ObjCEmptyVtableVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_vtable');
 | 
						||
    list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar));
 | 
						||
    { the read-only part }
 | 
						||
    list.Concat(Tai_const.Create_sym(metarosym));
 | 
						||
 | 
						||
    { 2) regular class declaration }
 | 
						||
    list.Concat(tai_symbol.Create_Global(clssym,0));
 | 
						||
 | 
						||
    { the isa }
 | 
						||
    list.Concat(Tai_const.Create_sym(metasym));
 | 
						||
    { the superclass }
 | 
						||
    list.Concat(Tai_const.Create_sym(superSym));
 | 
						||
    { pointer to cache }
 | 
						||
    list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar));
 | 
						||
    { pointer to vtable }
 | 
						||
    list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar));
 | 
						||
    { the read-only part }
 | 
						||
    list.Concat(Tai_const.Create_sym(rosym));
 | 
						||
 | 
						||
    classlabel:=clssym;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
procedure tobjcrttiwriter_nonfragile.addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist);
 | 
						||
  var
 | 
						||
    i: longint;
 | 
						||
    sym: TAsmSymbol;
 | 
						||
  begin
 | 
						||
    if classes.count=0 then
 | 
						||
      exit;
 | 
						||
    new_section(list,section,symname,sizeof(pint));
 | 
						||
    sym:=current_asmdata.DefineAsmSymbol(symname,AB_LOCAL,AT_DATA);
 | 
						||
    list.concat(tai_symbol.Create(sym,0));
 | 
						||
    for i:=0 to classes.count-1 do
 | 
						||
      list.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(tobjectdef(classes[i]).rtti_mangledname(objcclassrtti))));
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
procedure tobjcrttiwriter_nonfragile.gen_objc_info_sections(list: tasmlist);
 | 
						||
 | 
						||
  function collectnonlazyclasses(classes: tfpobjectlist): tfpobjectlist;
 | 
						||
    var
 | 
						||
      symentry : tsym;
 | 
						||
      procdef  : tprocdef;
 | 
						||
      i,j      : longint;
 | 
						||
    begin
 | 
						||
      { non-lazy classes are all classes that define a class method with the
 | 
						||
        selector called "load" (simply inheriting this class method is not enough,
 | 
						||
        they have to implement it themselves)
 | 
						||
 | 
						||
        -- TODO: this currently only works if the Pascal identifier is also 'load'! }
 | 
						||
      result:=tfpobjectlist.create(false);
 | 
						||
      for i:=0 to classes.count-1 do
 | 
						||
        begin
 | 
						||
          symentry:=tsym(tobjectsymtable(tobjectdef(classes[i]).symtable).find('LOAD'));
 | 
						||
          if assigned(symentry) and
 | 
						||
             (symentry.typ=procsym) then
 | 
						||
            begin
 | 
						||
              for j:=0 to tprocsym(symentry).ProcdefList.count do
 | 
						||
                begin
 | 
						||
                  procdef:=tprocdef(tprocsym(symentry).ProcdefList[0]);
 | 
						||
                  if ((po_classmethod in procdef.procoptions) and
 | 
						||
                      (procdef.messageinf.str^='load')) then
 | 
						||
                    begin
 | 
						||
                      result.add(classes[i]);
 | 
						||
                      break;
 | 
						||
                    end;
 | 
						||
                end;
 | 
						||
            end;
 | 
						||
        end;
 | 
						||
    end;
 | 
						||
 | 
						||
  var
 | 
						||
    nonlazyclasses,
 | 
						||
    nonlazycategories : tfpobjectlist;
 | 
						||
  begin
 | 
						||
    if (classdefs.count=0) and
 | 
						||
       (catdefs.count=0) then
 | 
						||
      exit;
 | 
						||
 | 
						||
    nonlazyclasses:=collectnonlazyclasses(classdefs);
 | 
						||
    nonlazycategories:=collectnonlazyclasses(catdefs);
 | 
						||
 | 
						||
    { this list has to include all classes, also the non-lazy ones }
 | 
						||
    addclasslist(list,sec_objc_classlist,target_asm.labelprefix+'_OBJC_LABEL_CLASS_$',classdefs);
 | 
						||
    addclasslist(list,sec_objc_nlclasslist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CLASS_$',nonlazyclasses);
 | 
						||
    { category and non-lazy category lists }
 | 
						||
    addclasslist(list,sec_objc_catlist,target_asm.labelprefix+'_OBJC_LABEL_CATEGORY_$',catdefs);
 | 
						||
    addclasslist(list,sec_objc_nlcatlist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CATEGORY_$',nonlazycategories);
 | 
						||
 | 
						||
    nonlazyclasses.free;
 | 
						||
    nonlazycategories.free;
 | 
						||
    { the non-fragile abi doesn't have any module info, nor lazy references
 | 
						||
      to used classes or to parent classes }
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
constructor tobjcrttiwriter_nonfragile.create;
 | 
						||
  begin
 | 
						||
    inherited create(oa_nonfragile);
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
{******************************************************************
 | 
						||
                 RTTI generation -- Main function
 | 
						||
*******************************************************************}
 | 
						||
 | 
						||
procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable);
 | 
						||
  var
 | 
						||
    objcrttiwriter: tobjcrttiwriter;
 | 
						||
  begin
 | 
						||
    if (m_objectivec1 in current_settings.modeswitches) then
 | 
						||
      begin
 | 
						||
        { first 4 bytes contain version information about this section (currently version 0),
 | 
						||
          next 4 bytes contain flags (currently only regarding whether the code in the object
 | 
						||
          file supports or requires garbage collection)
 | 
						||
        }
 | 
						||
        new_section(current_asmdata.asmlists[al_objc_data],sec_objc_image_info,'_OBJC_IMAGE_INFO',sizeof(pint));
 | 
						||
        current_asmdata.asmlists[al_objc_data].concat(Tai_symbol.Createname(target_asm.labelprefix+'_OBJC_IMAGE_INFO',AT_LABEL,sizeof(pint)));
 | 
						||
        current_asmdata.asmlists[al_objc_data].concat(Tai_const.Create_64bit(0));
 | 
						||
 | 
						||
        { generate rtti for all obj-c classes, protocols and categories
 | 
						||
          defined in this module. }
 | 
						||
        if not(target_info.system in systems_objc_nfabi) then
 | 
						||
          objcrttiwriter:=tobjcrttiwriter_fragile.create
 | 
						||
        else
 | 
						||
          objcrttiwriter:=tobjcrttiwriter_nonfragile.create;
 | 
						||
        objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],globalst);
 | 
						||
        objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],localst);
 | 
						||
        objcrttiwriter.gen_objc_info_sections(current_asmdata.asmlists[al_objc_data]);
 | 
						||
        objcrttiwriter.free;
 | 
						||
      end;
 | 
						||
  end;
 | 
						||
 | 
						||
 | 
						||
end.
 |