objcgutl.pas 69 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944
  1. {
  2. Copyright (c) 2009 by Jonas Maebe
  3. This unit implements some Objective-C helper routines at the code generator
  4. level.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License,or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$i fpcdefs.inc}
  19. unit objcgutl;
  20. interface
  21. uses
  22. cclasses,
  23. aasmbase,aasmdata,
  24. symbase,symdef;
  25. procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype);
  26. procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef);
  27. procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable);
  28. implementation
  29. uses
  30. globtype,globals,fmodule,cutils,
  31. systems,
  32. aasmtai,
  33. cgbase,
  34. objcdef,objcutil,
  35. aasmcnst,
  36. symconst,symtype,symsym,symtable,
  37. verbose;
  38. type
  39. tobjcabi = (oa_fragile, oa_nonfragile);
  40. (* tivarlayouttype = (il_weak,il_strong); *)
  41. tobjcrttiwriter = class
  42. protected
  43. fabi: tobjcabi;
  44. classdefs,
  45. catdefs: tfpobjectlist;
  46. classrttidefs,
  47. catrttidefs: tfpobjectlist;
  48. classsyms,
  49. catsyms: tfpobjectlist;
  50. procedure gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmsymbol; classmethods, iscategory: Boolean);
  51. procedure gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel);
  52. procedure gen_objc_protocol_list(list:TAsmList; protolist: TFPObjectList; out protolistsym: TAsmLabel);
  53. procedure gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype;const sectname: string; out listsym: TAsmLabel);
  54. procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);virtual;abstract;
  55. procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol; out catlabeldef: tdef);virtual;abstract;
  56. procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol; out classlabeldef: tdef);virtual;abstract;
  57. procedure gen_objc_info_sections(list: tasmlist);virtual;abstract;
  58. public
  59. constructor create(_abi: tobjcabi);
  60. destructor destroy;override;
  61. procedure gen_objc_rtti_sections(list:TAsmList; st:TSymtable);
  62. property abi: tobjcabi read fabi;
  63. end;
  64. { Used by by PowerPC/32 and i386 }
  65. tobjcrttiwriter_fragile = class(tobjcrttiwriter)
  66. protected
  67. function gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel;
  68. procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
  69. procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override;
  70. procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol; out catlabeldef: tdef);override;
  71. procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol; out classlabeldef: tdef);override;
  72. procedure gen_objc_info_sections(list: tasmlist);override;
  73. public
  74. constructor create;
  75. end;
  76. { Used by PowerPC/64, ARM, x86_64 and AArch64 }
  77. tobjcrttiwriter_nonfragile = class(tobjcrttiwriter)
  78. protected
  79. ObjCEmptyCacheVar,
  80. ObjCEmptyVtableVar: TAsmSymbol;
  81. procedure gen_objc_class_ro_part(list: TAsmList; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: TAsmSymbol; metaclass: boolean);
  82. procedure addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist);
  83. procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
  84. procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override;
  85. procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol; out catlabeldef: tdef);override;
  86. procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol; out classlabeldef: tdef);override;
  87. procedure gen_objc_info_sections(list: tasmlist);override;
  88. public
  89. constructor create;
  90. end;
  91. {******************************************************************
  92. Protocol declaration helpers
  93. *******************************************************************}
  94. function objcfindprotocolentry(const p: shortstring): TAsmSymbol;
  95. var
  96. item : PHashSetItem;
  97. begin
  98. result:=nil;
  99. if not assigned(current_asmdata.ConstPools[sp_objcprotocolrefs]) then
  100. exit;
  101. item:=current_asmdata.constpools[sp_objcprotocolrefs].Find(@p[1], length(p));
  102. if not assigned(item) then
  103. exit;
  104. result:=TAsmSymbol(item^.Data);
  105. end;
  106. function objcaddprotocolentry(const p: shortstring; ref: TAsmSymbol): Boolean;
  107. var
  108. item : PHashSetItem;
  109. begin
  110. item:=current_asmdata.constpools[sp_objcprotocolrefs].FindOrAdd(@p[1], length(p));
  111. Result:=(item^.Data=nil);
  112. if Result then
  113. item^.Data:=ref;
  114. end;
  115. {******************************************************************
  116. Pool section helpers
  117. *******************************************************************}
  118. procedure objcreatestringpoolentryintern(p: pchar; len: longint; pooltype: tconstpooltype; stringsec: tasmsectiontype; out sym: TAsmLabel; out def: tdef);
  119. var
  120. entry : PHashSetItem;
  121. strlab : tasmlabel;
  122. pc : pchar;
  123. pool : THashSet;
  124. tcb : ttai_typedconstbuilder;
  125. begin
  126. pool := current_asmdata.constpools[pooltype];
  127. entry:=pool.FindOrAdd(p,len);
  128. if not assigned(entry^.data) then
  129. begin
  130. { create new entry }
  131. current_asmdata.getlabel(strlab,alt_data);
  132. entry^.Data:=strlab;
  133. getmem(pc,entry^.keylength+1);
  134. move(entry^.key^,pc^,entry^.keylength);
  135. pc[entry^.keylength]:=#0;
  136. { add the string to the approriate section }
  137. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section]);
  138. def:=tcb.emit_pchar_const(pc,entry^.keylength,false);
  139. current_asmdata.asmlists[al_objc_pools].concatList(
  140. tcb.get_final_asmlist(strlab,def,stringsec,strlab.name,1)
  141. );
  142. tcb.free;
  143. def:=cpointerdef.getreusable(def);
  144. end
  145. else
  146. def:=cpointerdef.getreusable(carraydef.getreusable(cansichartype,len+1));
  147. sym:=TAsmLabel(Entry^.Data);
  148. end;
  149. procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype);
  150. var
  151. reflab,
  152. strlab : tasmlabel;
  153. classname: string;
  154. tcb: ttai_typedconstbuilder;
  155. strdef: tdef;
  156. begin
  157. { have we already generated a reference for this string entry? }
  158. if not assigned(entry^.Data) then
  159. begin
  160. { no, add the string to the associated strings section }
  161. objcreatestringpoolentryintern(pchar(entry^.key),entry^.keylength,stringpool,stringsec,strlab,strdef);
  162. { and now finish the reference }
  163. current_asmdata.getlabel(reflab,alt_data);
  164. entry^.Data:=reflab;
  165. { add a pointer to the string in the string references section }
  166. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section,tcalo_no_dead_strip]);
  167. tcb.emit_tai(Tai_const.Create_sym(strlab),strdef);
  168. current_asmdata.asmlists[al_objc_pools].concatList(
  169. tcb.get_final_asmlist(reflab,strdef,refsec,reflab.name,sizeof(pint))
  170. );
  171. tcb.free;
  172. { in case of a class reference, also add a lazy symbol reference for
  173. the class (the linker requires this for the fragile ABI). }
  174. if (refsec=sec_objc_cls_refs) and
  175. not(target_info.system in systems_objc_nfabi) then
  176. begin
  177. classname:='';
  178. setlength(classname,entry^.keylength);
  179. move(entry^.key^,classname[1],entry^.keylength);
  180. { no way to express this in LLVM either, they also just emit
  181. module level assembly for it }
  182. current_asmdata.asmlists[al_pure_assembler].concat(tai_directive.Create(asd_lazy_reference,'.objc_class_name_'+classname));
  183. end;
  184. end;
  185. end;
  186. procedure objcreatestringpoolentry(const s: string; pooltype: tconstpooltype; stringsec: tasmsectiontype; out sym: TAsmLabel; out def: tdef);
  187. begin
  188. objcreatestringpoolentryintern(@s[1],length(s),pooltype,stringsec,sym,def);
  189. end;
  190. procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef);
  191. var
  192. reflab: TAsmLabel;
  193. classym: TasmSymbol;
  194. tcb: ttai_typedconstbuilder;
  195. begin
  196. { have we already generated a reference for this class ref entry? }
  197. if not assigned(entry^.Data) then
  198. begin
  199. { no, add the classref to the sec_objc_cls_refs section }
  200. current_asmdata.getlabel(reflab,alt_data);
  201. entry^.Data:=reflab;
  202. { add a pointer to the class }
  203. classym:=current_asmdata.RefAsmSymbol(classdef.rtti_mangledname(objcclassrtti),AT_DATA);
  204. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section]);
  205. tcb.emit_tai(Tai_const.Create_sym(classym),voidpointertype);
  206. current_asmdata.asmlists[al_objc_pools].concatList(
  207. tcb.get_final_asmlist(reflab,voidpointertype,sec_objc_cls_refs,reflab.name,sizeof(pint))
  208. );
  209. tcb.free;
  210. end;
  211. end;
  212. {******************************************************************
  213. RTTI generation -- Helpers
  214. *******************************************************************}
  215. procedure ConcatSymOrNil(tcb: ttai_typedconstbuilder; sym: TAsmSymbol; def: tdef); inline;
  216. begin
  217. if Assigned(sym) then
  218. tcb.emit_tai(tai_const.Create_sym(sym),def)
  219. else
  220. tcb.emit_tai(tai_const.Create_nil_dataptr,def);
  221. end;
  222. {******************************************************************
  223. RTTI generation -- Common
  224. *******************************************************************}
  225. { generate a method list, either of class methods or of instance methods,
  226. and both for obj-c classes and categories. }
  227. procedure tobjcrttiwriter.gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmsymbol; classmethods, iscategory: Boolean);
  228. const
  229. {clas/cat inst/cls}
  230. SectType : array [Boolean, Boolean] of tasmsectiontype =
  231. ((sec_objc_inst_meth, sec_objc_cls_meth),
  232. (sec_objc_cat_inst_meth, sec_objc_cat_cls_meth));
  233. {clas/cat inst/cls}
  234. SectName : array [Boolean, Boolean] of string[20] =
  235. (('_OBJC_INST_METH','_OBJC_CLS_METH'),
  236. ('_OBJC_CAT_INST_METH','_OBJC_CAT_CLS_METH'));
  237. {frag/non-frag ABI}
  238. SectFlags : array [Boolean] of ttcasmlistoptions =
  239. ([tcalo_new_section],[tcalo_new_section,tcalo_no_dead_strip]);
  240. {inst/cls}
  241. instclsName : array [Boolean] of string = ('INSTANCE','CLASS');
  242. type
  243. method_data = record
  244. def : tprocdef;
  245. selsym : TAsmLabel;
  246. seldef : tdef;
  247. encsym : TAsmLabel;
  248. encdef : tdef;
  249. end;
  250. var
  251. i : Integer;
  252. def : tprocdef;
  253. defs : array of method_data;
  254. mcnt : integer;
  255. mtype : tdef;
  256. tcb : ttai_typedconstbuilder;
  257. mdef : tdef;
  258. begin
  259. methodslabel:=nil;
  260. mcnt:=0;
  261. defs:=nil;
  262. { collect all instance/class methods }
  263. SetLength(defs,objccls.vmtentries.count);
  264. for i:=0 to objccls.vmtentries.count-1 do
  265. begin
  266. def:=pvmtentry(objccls.vmtentries[i])^.procdef;
  267. if (def.owner.defowner=objccls) and
  268. (classmethods = (po_classmethod in def.procoptions)) then
  269. begin
  270. defs[mcnt].def:=def;
  271. objcreatestringpoolentry(def.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names,defs[mcnt].selsym,defs[mcnt].seldef);
  272. objcreatestringpoolentry(objcencodemethod(def),sp_objcvartypes,sec_objc_meth_var_types,defs[mcnt].encsym,defs[mcnt].encdef);
  273. inc(mcnt);
  274. end;
  275. end;
  276. if mcnt=0 then
  277. exit;
  278. tcb:=ctai_typedconstbuilder.create(SectFlags[target_info.system in systems_objc_nfabi]);
  279. tcb.begin_anonymous_record(internaltypeprefixName[itp_objc_method_list]+tostr(mcnt),
  280. C_alignment,1,
  281. targetinfos[target_info.system]^.alignment.recordalignmin,
  282. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  283. if (abi=oa_fragile) then
  284. { not used, always zero }
  285. tcb.emit_ord_const(0,u32inttype)
  286. else
  287. begin
  288. { size of each entry -- always 32 bit value }
  289. mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef;
  290. tcb.emit_ord_const(mtype.size,u32inttype);
  291. end;
  292. { number of objc_method entries in the method_list array -- always 32 bit}
  293. tcb.emit_ord_const(mcnt,u32inttype);
  294. for i:=0 to mcnt-1 do
  295. begin
  296. { reference to the selector name }
  297. tcb.queue_init(charpointertype);
  298. tcb.queue_emit_asmsym(defs[i].selsym,defs[i].seldef);
  299. { reference to the obj-c encoded function parameters (signature) }
  300. tcb.queue_init(charpointertype);
  301. tcb.queue_emit_asmsym(defs[i].encsym,defs[i].encdef);
  302. { mangled name of the method }
  303. tcb.queue_init(voidcodepointertype);
  304. tcb.queue_emit_proc(defs[i].def);
  305. end;
  306. mdef:=tcb.end_anonymous_record;
  307. if iscategory then
  308. begin
  309. methodslabel:=current_asmdata.DefineAsmSymbol('l_OBJC_$_CATEGORY_'+instclsName[classmethods]+'_METHODS_'+objccls.objextname^+'_$_'+objccls.childof.objextname^,AB_LOCAL,AT_DATA,mdef);
  310. end
  311. else
  312. begin
  313. methodslabel:=current_asmdata.DefineAsmSymbol('l_OBJC_$_'+instclsName[classmethods]+'_METHODS_'+objccls.objextname^,AB_LOCAL,AT_DATA,mdef);
  314. end;
  315. list.concatList(
  316. tcb.get_final_asmlist(methodslabel,mdef,
  317. SectType[iscategory,classmethods],
  318. SectName[iscategory,classmethods],sizeof(ptrint)
  319. )
  320. );
  321. tcb.free;
  322. end;
  323. { generate method (and in the future also property) info for protocols }
  324. procedure tobjcrttiwriter.gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel);
  325. var
  326. proc : tprocdef;
  327. reqinstmlist,
  328. reqclsmlist,
  329. optinstmlist,
  330. optclsmlist : TFPObjectList;
  331. i : ptrint;
  332. begin
  333. reqinstmlist:=TFPObjectList.Create(false);
  334. reqclsmlist:=TFPObjectList.Create(false);
  335. optinstmlist:=TFPObjectList.Create(false);
  336. optclsmlist:=TFPObjectList.Create(false);
  337. for i:=0 to protocol.vmtentries.Count-1 do
  338. begin
  339. proc:=pvmtentry(protocol.vmtentries[i])^.procdef;
  340. if (po_classmethod in proc.procoptions) then
  341. if not(po_optional in proc.procoptions) then
  342. reqclsmlist.Add(proc)
  343. else
  344. optclsmlist.Add(proc)
  345. else if not(po_optional in proc.procoptions) then
  346. reqinstmlist.Add(proc)
  347. else
  348. optinstmlist.Add(proc);
  349. end;
  350. if reqinstmlist.Count > 0 then
  351. gen_objc_cat_methods(list,reqinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',reqinstsym)
  352. else
  353. reqinstsym:=nil;
  354. if optinstmlist.Count > 0 then
  355. gen_objc_cat_methods(list,optinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',optinstsym)
  356. else
  357. optinstsym:=nil;
  358. if reqclsmlist.Count>0 then
  359. gen_objc_cat_methods(list,reqclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',reqclssym)
  360. else
  361. reqclssym:=nil;
  362. if optclsmlist.Count>0 then
  363. gen_objc_cat_methods(list,optclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',optclssym)
  364. else
  365. optclssym:=nil;
  366. reqinstmlist.Free;
  367. reqclsmlist.Free;
  368. optinstmlist.Free;
  369. optclsmlist.Free;
  370. end;
  371. (*
  372. From CLang:
  373. struct objc_protocol_list
  374. {
  375. #ifdef FRAGILE_ABI
  376. struct objc_protocol_list *next;
  377. int count;
  378. #else
  379. long count;
  380. #endif
  381. Protocol *list[1];
  382. };
  383. *)
  384. procedure tobjcrttiwriter.gen_objc_protocol_list(list: tasmlist; protolist: tfpobjectlist; out protolistsym: tasmlabel);
  385. var
  386. i : Integer;
  387. protosym : TAsmSymbol;
  388. protodef : tobjectdef;
  389. tcb : ttai_typedconstbuilder;
  390. begin
  391. if not Assigned(protolist) or
  392. (protolist.Count=0) then
  393. begin
  394. protolistsym:=nil;
  395. Exit;
  396. end;
  397. for i:=0 to protolist.Count-1 do
  398. begin
  399. protodef:=TImplementedInterface(protolist[i]).IntfDef;
  400. protosym:=objcfindprotocolentry(protodef.objextname^);
  401. if not assigned(protosym) then
  402. begin
  403. gen_objc_protocol(list,protodef,protosym);
  404. objcaddprotocolentry(protodef.objextname^,protosym);
  405. end;
  406. end;
  407. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section]);
  408. tcb.begin_anonymous_record(internaltypeprefixName[itp_objc_proto_list]+tostr(protolist.Count),
  409. C_alignment,1,
  410. targetinfos[target_info.system]^.alignment.recordalignmin,
  411. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  412. { protocol lists are stored in .objc_cat_cls_meth section }
  413. current_asmdata.getlabel(protolistsym, alt_data);
  414. if (abi=oa_fragile) then
  415. { From Clang: next, always nil}
  416. tcb.emit_tai(tai_const.Create_nil_dataptr,ptruinttype);
  417. { From Clang: protocols count}
  418. tcb.emit_tai(Tai_const.Create_int_dataptr(protolist.Count),ptruinttype);
  419. for i:=0 to protolist.Count-1 do
  420. begin
  421. protodef:=(protolist[i] as TImplementedInterface).IntfDef;
  422. protosym:=objcfindprotocolentry(protodef.objextname^);
  423. if not Assigned(protosym) then
  424. begin
  425. { For some reason protosym is not declared, though must be!
  426. Probably gen_obcj1_protocol returned wrong protosym
  427. }
  428. InternalError(2009091602);
  429. end;
  430. tcb.emit_tai(tai_const.Create_sym(protosym),voidpointertype);
  431. end;
  432. list.concatList(
  433. tcb.get_final_asmlist(
  434. protolistsym,tcb.end_anonymous_record,
  435. sec_objc_cat_cls_meth,'_OBJC_PROTOCOLLIST',sizeof(pint)
  436. )
  437. );
  438. tcb.free;
  439. { the symbol will point to a record }
  440. end;
  441. { Generate rtti for an Objective-C methods (methods without implementation) }
  442. { items : TFPObjectList of Tprocdef }
  443. procedure tobjcrttiwriter.gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype;
  444. const sectname: string; out listsym: TAsmLabel);
  445. var
  446. i : integer;
  447. m : tprocdef;
  448. lab : tasmlabel;
  449. ldef : tdef;
  450. mtype : tdef;
  451. tcb : ttai_typedconstbuilder;
  452. begin
  453. if not assigned(items) or
  454. (items.count=0) then
  455. exit;
  456. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section]);
  457. current_asmdata.getlabel(listsym,alt_data);
  458. tcb.begin_anonymous_record(
  459. internaltypeprefixName[itp_objc_cat_methods]+tostr(items.count),
  460. C_alignment,1,
  461. targetinfos[target_info.system]^.alignment.recordalignmin,
  462. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  463. if (abi=oa_nonfragile) then
  464. begin
  465. { size of each entry -- always 32 bit value }
  466. mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef;
  467. tcb.emit_ord_const(mtype.size,u32inttype);
  468. end;
  469. tcb.emit_ord_const(items.count,u32inttype);
  470. for i:=0 to items.Count-1 do
  471. begin
  472. m:=tprocdef(items[i]);
  473. objcreatestringpoolentry(m.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names,lab,ldef);
  474. tcb.emit_tai(Tai_const.Create_sym(lab),ldef);
  475. objcreatestringpoolentry(objcencodemethod(m),sp_objcvartypes,sec_objc_meth_var_types,lab,ldef);
  476. tcb.emit_tai(Tai_const.Create_sym(lab),ldef);
  477. { placeholder for address of implementation? }
  478. if (abi=oa_nonfragile) then
  479. tcb.emit_tai(Tai_const.Create_nil_codeptr,codeptruinttype);
  480. end;
  481. list.concatList(
  482. tcb.get_final_asmlist(
  483. listsym,tcb.end_anonymous_record,section,sectname,sizeof(pint))
  484. );
  485. tcb.free;
  486. end;
  487. { Generate the rtti sections for all obj-c classes defined in st, and return
  488. these classes in the classes list. }
  489. procedure tobjcrttiwriter.gen_objc_rtti_sections(list:TAsmList; st:TSymtable);
  490. var
  491. i: longint;
  492. def,
  493. rttidef: tdef;
  494. sym: TAsmSymbol;
  495. begin
  496. if not Assigned(st) then
  497. exit;
  498. for i:=0 to st.DefList.Count-1 do
  499. begin
  500. def:=tdef(st.DefList[i]);
  501. { check whether all types used in Objective-C class/protocol/category
  502. declarations can be used with the Objective-C run time (can only be
  503. done now, because at parse-time some of these types can still be
  504. forwarddefs) }
  505. if is_objc_class_or_protocol(def) then
  506. if not tobjectdef(def).check_objc_types then
  507. continue;
  508. if is_objcclass(def) and
  509. not(oo_is_external in tobjectdef(def).objectoptions) then
  510. begin
  511. if not(oo_is_classhelper in tobjectdef(def).objectoptions) then
  512. begin
  513. gen_objc_classes_sections(list,tobjectdef(def),sym,rttidef);
  514. classsyms.add(sym);
  515. classrttidefs.add(rttidef);
  516. classdefs.add(def);
  517. end
  518. else
  519. begin
  520. gen_objc_category_sections(list,tobjectdef(def),sym,rttidef);
  521. catsyms.add(sym);
  522. catrttidefs.add(rttidef);
  523. catdefs.add(def);
  524. end
  525. end;
  526. end;
  527. end;
  528. constructor tobjcrttiwriter.create(_abi: tobjcabi);
  529. begin
  530. fabi:=_abi;
  531. classdefs:=tfpobjectlist.create(false);
  532. classsyms:=tfpobjectlist.create(false);
  533. classrttidefs:=tfpobjectlist.create(false);
  534. catrttidefs:=tfpobjectlist.create(false);
  535. catdefs:=tfpobjectlist.create(false);
  536. catsyms:=tfpobjectlist.create(false);
  537. end;
  538. destructor tobjcrttiwriter.destroy;
  539. begin
  540. classdefs.free;
  541. classsyms.free;
  542. classrttidefs.free;
  543. catrttidefs.free;
  544. catdefs.free;
  545. catsyms.free;
  546. inherited destroy;
  547. end;
  548. {******************************************************************
  549. RTTI generation -- Fragile ABI
  550. *******************************************************************}
  551. { generate an instance variables list for an obj-c class. }
  552. procedure tobjcrttiwriter_fragile.gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel);
  553. type
  554. ivar_data = record
  555. vf : tfieldvarsym;
  556. namesym : TAsmLabel;
  557. namedef : tdef;
  558. typesym : TAsmLabel;
  559. typedef : tdef;
  560. end;
  561. var
  562. i : integer;
  563. vf : tfieldvarsym;
  564. vars : array of ivar_data;
  565. vcnt : Integer;
  566. enctype : ansistring;
  567. encerr : tdef;
  568. begin
  569. ivarslabel:=nil;
  570. vcnt:=0;
  571. vars:=nil;
  572. setLength(vars,objccls.symtable.SymList.Count);
  573. for i:=0 to objccls.symtable.SymList.Count-1 do
  574. if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then
  575. begin
  576. vf:=tfieldvarsym(objccls.symtable.SymList[i]);
  577. if objctryencodetype(vf.vardef,enctype,encerr) then
  578. begin
  579. vars[vcnt].vf:=vf;
  580. objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names,vars[vcnt].namesym,vars[vcnt].namedef);
  581. objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types,vars[vcnt].typesym,vars[vcnt].typedef);
  582. inc(vcnt);
  583. end
  584. else
  585. { Should be caught during parsing }
  586. internalerror(2009090601);
  587. end;
  588. if vcnt=0 then
  589. exit;
  590. new_section(list,sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint));
  591. current_asmdata.getlabel(ivarslabel,alt_data);
  592. list.Concat(tai_label.Create(ivarslabel));
  593. { objc_ivar_list: first the number of elements }
  594. list.Concat(tai_const.Create_32bit(vcnt));
  595. for i:=0 to vcnt-1 do
  596. begin
  597. { reference to the instance variable name }
  598. list.Concat(tai_const.Create_sym(vars[i].namesym));
  599. { reference to the encoded type }
  600. list.Concat(tai_const.Create_sym(vars[i].typesym));
  601. { and the offset of the field }
  602. list.Concat(tai_const.Create_32bit(vars[i].vf.fieldoffset));
  603. end;
  604. end;
  605. (* From GCC:
  606. struct _objc_protocol_extension
  607. {
  608. uint32_t size; // sizeof (struct _objc_protocol_extension)
  609. struct objc_method_list *optional_instance_methods;
  610. struct objc_method_list *optional_class_methods;
  611. struct objc_prop_list *instance_properties;
  612. }
  613. *)
  614. function tobjcrttiwriter_fragile.gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel;
  615. var
  616. tcb: ttai_typedconstbuilder;
  617. begin
  618. if assigned(optinstsym) or
  619. assigned(optclssym) then
  620. begin
  621. current_asmdata.getlabel(Result,alt_data);
  622. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  623. tcb.begin_anonymous_record(
  624. internaltypeprefixName[itb_objc_fr_protocol_ext],
  625. C_alignment,1,
  626. targetinfos[target_info.system]^.alignment.recordalignmin,
  627. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  628. { size of this structure }
  629. tcb.emit_ord_const(16,u32inttype);
  630. { optional instance methods }
  631. ConcatSymOrNil(tcb,optinstsym,voidpointertype);
  632. { optional class methods }
  633. ConcatSymOrNil(tcb,optclssym,voidpointertype);
  634. { optional properties (todo) }
  635. ConcatSymOrNil(tcb,nil,voidpointertype);
  636. list.concatList(
  637. tcb.get_final_asmlist(
  638. result,tcb.end_anonymous_record,
  639. sec_objc_protocol_ext,'_OBJC_PROTOCOLEXT',sizeof(pint)
  640. )
  641. );
  642. tcb.free;
  643. end
  644. else
  645. Result:=nil;
  646. end;
  647. { Generate rtti for an Objective-C protocol }
  648. procedure tobjcrttiwriter_fragile.gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);
  649. var
  650. namesym : TAsmLabel;
  651. namedef : tdef;
  652. protolist : TAsmLabel;
  653. reqinstsym,
  654. optinstsym,
  655. reqclssym,
  656. optclssym,
  657. protoext,
  658. lbl : TAsmLabel;
  659. tcb : ttai_typedconstbuilder;
  660. begin
  661. gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist);
  662. gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym);
  663. protoext:=gen_objc_protocol_ext(list,optinstsym,optclssym);
  664. current_asmdata.getlabel(lbl,alt_data);
  665. protocollabel:=lbl;
  666. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  667. tcb.begin_anonymous_record(
  668. internaltypeprefixName[itb_objc_fr_protocol],
  669. C_alignment,1,
  670. targetinfos[target_info.system]^.alignment.recordalignmin,
  671. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  672. { protocol's isa - points to information about optional methods/properties }
  673. ConcatSymOrNil(tcb,protoext,voidpointertype);
  674. { name }
  675. objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names,namesym,namedef);
  676. tcb.queue_init(voidpointertype);
  677. tcb.queue_emit_asmsym(namesym,namedef);
  678. { protocol's list }
  679. ConcatSymOrNil(tcb,protolist,voidpointertype);
  680. { instance methods, in __cat_inst_meth }
  681. ConcatSymOrNil(tcb,reqinstsym,voidpointertype);
  682. { class methods, in __cat_cls_meth }
  683. ConcatSymOrNil(tcb,reqclssym,voidpointertype);
  684. list.concatList(
  685. tcb.get_final_asmlist(
  686. lbl,tcb.end_anonymous_record,
  687. sec_objc_protocol,'_OBJC_PROTOCOL',sizeof(pint)
  688. )
  689. );
  690. tcb.free;
  691. end;
  692. (*
  693. From Clang:
  694. struct _objc_category {
  695. char *category_name;
  696. char *class_name;
  697. struct _objc_method_list *instance_methods;
  698. struct _objc_method_list *class_methods;
  699. struct _objc_protocol_list *protocols;
  700. uint32_t size; // <rdar://4585769>
  701. struct _objc_property_list *instance_properties;
  702. };
  703. *)
  704. { Generate rtti for an Objective-C class and its meta-class. }
  705. procedure tobjcrttiwriter_fragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol; out catlabeldef: tdef);
  706. var
  707. catstrsym,
  708. clsstrsym,
  709. protolistsym : TAsmLabel;
  710. instmthdlist,
  711. clsmthdlist,
  712. catsym : TAsmSymbol;
  713. catstrdef,
  714. clsstrdef,
  715. catdef : tdef;
  716. tcb : ttai_typedconstbuilder;
  717. begin
  718. { the category name }
  719. objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names,catstrsym,catstrdef);
  720. { the name of the class it extends }
  721. objcreatestringpoolentry(objccat.childof.objextname^,sp_objcclassnames,sec_objc_class_names,clsstrsym,clsstrdef);
  722. { generate the methods lists }
  723. gen_objc_methods(list,objccat,instmthdlist,false,true);
  724. gen_objc_methods(list,objccat,clsmthdlist,true,true);
  725. { generate implemented protocols list }
  726. gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym);
  727. { category declaration section }
  728. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  729. tcb.begin_anonymous_record(
  730. internaltypeprefixName[itb_objc_fr_category],
  731. C_alignment,1,
  732. targetinfos[target_info.system]^.alignment.recordalignmin,
  733. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  734. tcb.queue_init(voidpointertype);
  735. tcb.queue_emit_asmsym(catstrsym,catstrdef);
  736. tcb.queue_init(voidpointertype);
  737. tcb.queue_emit_asmsym(clsstrsym,clsstrdef);
  738. ConcatSymOrNil(tcb,instmthdlist,voidpointertype);
  739. ConcatSymOrNil(tcb,clsmthdlist,voidpointertype);
  740. ConcatSymOrNil(tcb,protolistsym,voidpointertype);
  741. { size of this structure }
  742. tcb.emit_ord_const(28,u32inttype);
  743. { properties, not yet supported }
  744. tcb.emit_ord_const(0,u32inttype);
  745. catdef:=tcb.end_anonymous_record;
  746. catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA,catdef);
  747. list.concatList(
  748. tcb.get_final_asmlist(
  749. catsym,catdef,
  750. sec_objc_category,'_OBJC_CATEGORY',sizeof(pint)
  751. )
  752. );
  753. tcb.free;
  754. catlabel:=catsym;
  755. catlabeldef:=catdef;
  756. end;
  757. (*
  758. From Clang:
  759. struct _objc_class {
  760. Class isa;
  761. Class super_class;
  762. const char *name;
  763. long version;
  764. long info;
  765. long instance_size;
  766. struct _objc_ivar_list *ivars;
  767. struct _objc_method_list *methods;
  768. struct _objc_cache *cache;
  769. struct _objc_protocol_list *protocols;
  770. // Objective-C 1.0 extensions (<rdr://4585769>) -- for garbage collection
  771. const char *ivar_layout;
  772. struct _objc_class_ext *ext;
  773. };
  774. *)
  775. { Generate rtti for an Objective-C class and its meta-class. }
  776. procedure tobjcrttiwriter_fragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol; out classlabeldef: tdef);
  777. const
  778. CLS_CLASS = 1;
  779. CLS_META = 2;
  780. CLS_HIDDEN = $20000;
  781. META_INST_SIZE = 40+8; // sizeof(objc_class) + 8
  782. var
  783. root : tobjectdef;
  784. metasym,
  785. mthdlist,
  786. clssym : TAsmSymbol;
  787. superStrDef,
  788. classStrDef,
  789. metaisaStrDef,
  790. metaDef,
  791. clsDef : tdef;
  792. superStrSym,
  793. classStrSym,
  794. metaisaStrSym,
  795. ivarslist,
  796. protolistsym : TAsmLabel;
  797. hiddenflag : cardinal;
  798. tcb : ttai_typedconstbuilder;
  799. begin
  800. { generate the class methods list }
  801. gen_objc_methods(list,objclss,mthdlist,true,false);
  802. { generate implemented protocols list }
  803. gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym);
  804. { register necessary names }
  805. { 1) the superclass }
  806. if assigned(objclss.childof) then
  807. objcreatestringpoolentry(objclss.childof.objextname^,sp_objcclassnames,sec_objc_class_names,superStrSym,superStrDef)
  808. else
  809. begin
  810. { not empty string, but nil! }
  811. superStrSym:=nil;
  812. superStrDef:=voidpointertype;
  813. end;
  814. { 2) the current class }
  815. objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names,classStrSym,classStrDef);
  816. { 3) the isa }
  817. { From Clang: The isa for the meta-class is the root of the hierarchy. }
  818. root:=objclss;
  819. while assigned(root.childof) do
  820. root:=root.childof;
  821. objcreatestringpoolentry(root.objextname^,sp_objcclassnames,sec_objc_class_names,metaisaStrSym,metaisaStrDef);
  822. { 4) the flags }
  823. { consider every class declared in the implementation section of a unit
  824. as "hidden"
  825. }
  826. hiddenflag:=0;
  827. if (objclss.owner.symtabletype=staticsymtable) and
  828. current_module.is_unit then
  829. hiddenflag:=CLS_HIDDEN;
  830. { class declaration section }
  831. { 1) meta-class declaration }
  832. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  833. tcb.begin_anonymous_record(internaltypeprefixName[itb_objc_fr_meta_class],
  834. C_alignment,1,
  835. targetinfos[target_info.system]^.alignment.recordalignmin,
  836. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  837. tcb.queue_init(voidpointertype);
  838. tcb.queue_emit_asmsym(metaisaStrSym,metaisaStrDef);
  839. { pointer to the superclass name if any, otherwise nil }
  840. if assigned(superstrsym) then
  841. begin
  842. tcb.queue_init(voidpointertype);
  843. tcb.queue_emit_asmsym(superStrSym,superStrDef);
  844. end
  845. else
  846. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  847. { pointer to the class name }
  848. tcb.queue_init(voidpointertype);
  849. tcb.queue_emit_asmsym(classStrSym,classStrDef);
  850. { version is always 0 currently }
  851. tcb.emit_ord_const(0,u32inttype);
  852. { CLS_META for meta-classes }
  853. tcb.emit_ord_const(hiddenflag or CLS_META,u32inttype);
  854. { size of the meta-class instance: sizeof(objc_class) + 8 bytes }
  855. tcb.emit_ord_const(META_INST_SIZE,u32inttype);
  856. { meta-classes don't have ivars list (=0) }
  857. tcb.emit_ord_const(0,u32inttype);
  858. { class methods list (stored in "__cls_meth" section) }
  859. ConcatSymOrNil(tcb,mthdlist,voidpointertype);
  860. { From Clang: cache is always nil }
  861. tcb.emit_ord_const(0,u32inttype);
  862. { protocols }
  863. ConcatSymOrNil(tcb,protolistsym,voidpointertype);
  864. { From Clang: ivar_layout for meta-class is always NULL. }
  865. tcb.emit_ord_const(0,u32inttype);
  866. { From Clang: The class extension is always unused for meta-classes. }
  867. tcb.emit_ord_const(0,u32inttype);
  868. metaDef:=tcb.end_anonymous_record;
  869. metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),AB_LOCAL,AT_DATA,metadef);
  870. list.concatList(
  871. tcb.get_final_asmlist(
  872. metasym,metaDef,
  873. sec_objc_meta_class,'_OBJC_META_CLASS',sizeof(pint)
  874. )
  875. );
  876. tcb.free;
  877. { 2) regular class declaration }
  878. { generate the instance methods list }
  879. gen_objc_methods(list,objclss,mthdlist,false,false);
  880. { generate the instance variables list }
  881. gen_objc_ivars(list,objclss,ivarslist);
  882. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  883. tcb.begin_anonymous_record(internaltypeprefixName[itb_objc_fr_class],
  884. C_alignment,1,
  885. targetinfos[target_info.system]^.alignment.recordalignmin,
  886. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  887. { for class declaration: the isa points to the meta-class declaration }
  888. tcb.emit_tai(Tai_const.Create_sym(metasym),cpointerdef.getreusable(metaDef));
  889. { pointer to the super_class name if any, nil otherwise }
  890. if assigned(superStrSym) then
  891. begin
  892. tcb.queue_init(voidcodepointertype);
  893. tcb.queue_emit_asmsym(superStrSym,superStrDef)
  894. end
  895. else
  896. tcb.emit_tai(Tai_const.Create_nil_dataptr,voidcodepointertype);
  897. { pointer to the class name }
  898. tcb.queue_init(voidcodepointertype);
  899. tcb.queue_emit_asmsym(classStrSym,classStrDef);
  900. { version is always 0 currently }
  901. tcb.emit_ord_const(0,u32inttype);
  902. { CLS_CLASS for classes }
  903. tcb.emit_ord_const(hiddenflag or CLS_CLASS,u32inttype);
  904. { size of instance: total size of instance variables }
  905. tcb.emit_ord_const(tobjectsymtable(objclss.symtable).datasize,u32inttype);
  906. { objc_ivar_list (stored in "__instance_vars" section) }
  907. ConcatSymOrNil(tcb,ivarslist,voidpointertype);
  908. { instance methods list (stored in "__inst_meth" section) }
  909. ConcatSymOrNil(tcb,mthdlist,voidpointertype);
  910. { From Clang: cache is always NULL }
  911. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  912. { protocols, protolistsym has been created for meta-class, no need to create another one}
  913. ConcatSymOrNil(tcb, protolistsym,voidpointertype);
  914. { From Clang: strong ivar_layout, necessary for garbage collection support }
  915. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  916. { TODO: From Clang: weak ivar_layout, necessary for garbage collection support }
  917. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  918. clsDef:=tcb.end_anonymous_record;
  919. clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA,clsDef);
  920. list.concatList(
  921. tcb.get_final_asmlist(
  922. clssym,clsDef,
  923. sec_objc_class,'_OBJC_CLASS',sizeof(pint)
  924. )
  925. );
  926. tcb.free;
  927. classlabel:=clssym;
  928. classlabeldef:=clsDef;
  929. end;
  930. { Generate the global information sections (objc_symbols and objc_module_info)
  931. for this module. }
  932. procedure tobjcrttiwriter_fragile.gen_objc_info_sections(list: tasmlist);
  933. var
  934. i: longint;
  935. sym : TAsmSymbol;
  936. lab : TAsmLabel;
  937. symsdef,
  938. def : tdef;
  939. parent: tobjectdef;
  940. superclasses: tfpobjectlist;
  941. tcb: ttai_typedconstbuilder;
  942. begin
  943. if (classsyms.count<>0) or
  944. (catsyms.count<>0) then
  945. begin
  946. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  947. tcb.begin_anonymous_record('',
  948. C_alignment,1,
  949. targetinfos[target_info.system]^.alignment.recordalignmin,
  950. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  951. { ??? (always 0 in Clang) }
  952. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  953. { ??? (From Clang: always 0, pointer to some selector) }
  954. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  955. { From Clang: number of defined classes }
  956. tcb.emit_ord_const(classsyms.count,u16inttype);
  957. { From Clang: number of defined categories }
  958. tcb.emit_ord_const(catsyms.count,u16inttype);
  959. { first all classes }
  960. for i:=0 to classsyms.count-1 do
  961. tcb.emit_tai(Tai_const.Create_sym(tasmsymbol(classsyms[i])),tdef(classrttidefs[i]));
  962. { then all categories }
  963. for i:=0 to catsyms.count-1 do
  964. tcb.emit_tai(Tai_const.Create_sym(tasmsymbol(catsyms[i])),tdef(catrttidefs[i]));
  965. symsdef:=tcb.end_anonymous_record;
  966. sym := current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_SYMBOLS_$',AB_LOCAL,AT_DATA,symsdef);
  967. list.concatList(tcb.get_final_asmlist(sym,
  968. symsdef,
  969. sec_objc_symbols,'_OBJC_SYMBOLS',
  970. sizeof(pint)));
  971. end
  972. else
  973. begin
  974. sym:=nil;
  975. symsdef:=nil;
  976. end;
  977. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  978. tcb.begin_anonymous_record('',
  979. C_alignment,1,
  980. targetinfos[target_info.system]^.alignment.recordalignmin,
  981. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  982. { version number = 7 (always, both for gcc and clang) }
  983. tcb.emit_ord_const(7,ptruinttype);
  984. { sizeof(objc_module): 4 pointer-size entities }
  985. tcb.emit_ord_const(sizeof(pint)*4,ptruinttype);
  986. { used to be file name, now unused (points to empty string) }
  987. objcreatestringpoolentry('',sp_objcclassnames,sec_objc_class_names,lab,def);
  988. tcb.emit_tai(Tai_const.Create_sym(lab),def);
  989. { pointer to classes/categories list declared in this module }
  990. if assigned(sym) then
  991. tcb.emit_tai(tai_const.Create_sym(sym),symsdef)
  992. else
  993. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  994. current_asmdata.getlabel(lab,alt_data);
  995. list.concatList(tcb.get_final_asmlist(lab,
  996. tcb.end_anonymous_record,sec_objc_module_info,'_OBJC_MODULE_INFO',4));
  997. { Add lazy references to parent classes of all classes defined in this unit }
  998. superclasses:=tfpobjectlist.create(false);
  999. for i:=0 to classdefs.count-1 do
  1000. begin
  1001. parent:=tobjectdef(classdefs[i]).childof;
  1002. { warning: linear search, performance hazard if large number of subclasses }
  1003. if assigned(parent) and
  1004. (superclasses.indexof(parent)=-1) then
  1005. begin
  1006. list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^));
  1007. superclasses.add(parent);
  1008. end;
  1009. end;
  1010. for i:=0 to catdefs.count-1 do
  1011. begin
  1012. parent:=tobjectdef(catdefs[i]).childof;
  1013. { warning: linear search, performance hazard if large number of subclasses }
  1014. if assigned(parent) and
  1015. (superclasses.indexof(parent)=-1) then
  1016. begin
  1017. list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^));
  1018. superclasses.add(parent);
  1019. end;
  1020. end;
  1021. superclasses.free;
  1022. { reference symbols for all classes and categories defined in this unit }
  1023. for i:=0 to classdefs.count-1 do
  1024. list.concat(tai_symbol.Createname_global_value('.objc_class_name_'+tobjectdef(classdefs[i]).objextname^,AT_DATA,0,0,voidpointertype));
  1025. for i:=0 to catdefs.count-1 do
  1026. list.concat(tai_symbol.Createname_global_value('.objc_category_name_'+
  1027. tobjectdef(catdefs[i]).childof.objextname^+'_'+
  1028. tobjectdef(catdefs[i]).objextname^,AT_DATA,0,0,voidpointertype));
  1029. end;
  1030. constructor tobjcrttiwriter_fragile.create;
  1031. begin
  1032. inherited create(oa_fragile);
  1033. end;
  1034. {******************************************************************
  1035. RTTI generation -- Non-Fragile ABI
  1036. *******************************************************************}
  1037. (*
  1038. From Clang:
  1039. /// EmitIvarList - Emit the ivar list for the given
  1040. /// implementation. The return value has type
  1041. /// IvarListnfABIPtrTy.
  1042. /// struct _ivar_t {
  1043. /// unsigned long int *offset; // pointer to ivar offset location
  1044. /// char *name;
  1045. /// char *type;
  1046. /// uint32_t alignment;
  1047. /// uint32_t size;
  1048. /// }
  1049. /// struct _ivar_list_t {
  1050. /// uint32 entsize; // sizeof(struct _ivar_t)
  1051. /// uint32 count;
  1052. /// struct _iver_t list[count];
  1053. /// }
  1054. ///
  1055. *)
  1056. procedure tobjcrttiwriter_nonfragile.gen_objc_ivars(list: tasmlist; objccls: tobjectdef; out ivarslabel: tasmlabel);
  1057. type
  1058. ivar_data = record
  1059. vf : tfieldvarsym;
  1060. namesym : TAsmLabel;
  1061. namedef : tdef;
  1062. typesym : TAsmLabel;
  1063. typedef : tdef;
  1064. offssym : TAsmSymbol;
  1065. end;
  1066. var
  1067. ivtype: tdef;
  1068. vf : tfieldvarsym;
  1069. vars : array of ivar_data;
  1070. i : integer;
  1071. vcnt : integer;
  1072. enctype : ansistring;
  1073. encerr : tdef;
  1074. prefix : shortstring;
  1075. vis : TAsmsymbind;
  1076. tcb : ttai_typedconstbuilder;
  1077. pptruinttype : tdef;
  1078. begin
  1079. ivarslabel:=nil;
  1080. prefix:='';
  1081. vcnt:=0;
  1082. vars:=nil;
  1083. setLength(vars,objccls.symtable.SymList.Count);
  1084. tcb:=nil;
  1085. prefix:='';
  1086. for i:=0 to objccls.symtable.SymList.Count-1 do
  1087. if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then
  1088. begin
  1089. vf:=tfieldvarsym(objccls.symtable.SymList[i]);
  1090. if objctryencodetype(vf.vardef,enctype,encerr) then
  1091. begin
  1092. vars[vcnt].vf:=vf;
  1093. objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names,vars[vcnt].namesym,vars[vcnt].namedef);
  1094. objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types,vars[vcnt].typesym,vars[vcnt].typedef);
  1095. if (vcnt=0) then
  1096. begin
  1097. tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1098. prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.';
  1099. end
  1100. else
  1101. tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1102. { This matches gcc/Clang, but is strange: I would expect private
  1103. fields to be local symbols rather than private_extern (which
  1104. is "package-global") (JM)
  1105. }
  1106. if not(vf.visibility in [vis_public,vis_protected,vis_strictprotected]) then
  1107. vis:=AB_PRIVATE_EXTERN
  1108. else
  1109. vis:=AB_GLOBAL;
  1110. vars[vcnt].offssym:=current_asmdata.DefineAsmSymbol(prefix+vf.RealName,vis,AT_DATA,ptruinttype);
  1111. tcb.emit_tai(tai_const.Create_int_dataptr(vf.fieldoffset),ptruinttype);
  1112. list.concatList(
  1113. tcb.get_final_asmlist(
  1114. vars[vcnt].offssym,ptruinttype,
  1115. sec_objc_const,'_OBJC_IVAR_OFFSETS',sizeof(pint)
  1116. )
  1117. );
  1118. tcb.free;
  1119. inc(vcnt);
  1120. end
  1121. else
  1122. { must be caught during parsing }
  1123. internalerror(2009092301);
  1124. end;
  1125. if vcnt=0 then
  1126. exit;
  1127. tcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_new_section,tcalo_no_dead_strip]);
  1128. current_asmdata.getlabel(ivarslabel,alt_data);
  1129. tcb.begin_anonymous_record(
  1130. internaltypeprefixName[itb_objc_nf_ivars]+tostr(vcnt),
  1131. C_alignment,1,
  1132. targetinfos[target_info.system]^.alignment.recordalignmin,
  1133. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1134. { size of each entry -- always 32 bit value }
  1135. ivtype:=search_named_unit_globaltype('OBJC','OBJC_IVAR',true).typedef;
  1136. tcb.emit_ord_const(ivtype.size,u32inttype);
  1137. { number of entries -- always 32 bit value }
  1138. tcb.emit_ord_const(vcnt,u32inttype);
  1139. { we use voidpointertype for all elements so that we can reuse the
  1140. recorddef for all ivar tables with the same number of elements }
  1141. pptruinttype:=cpointerdef.getreusable(ptruinttype);
  1142. for i:=0 to vcnt-1 do
  1143. begin
  1144. { reference to the offset }
  1145. tcb.emit_tai(tai_const.Create_sym(vars[i].offssym),pptruinttype);
  1146. { reference to the instance variable name (}
  1147. tcb.queue_init(voidpointertype);
  1148. tcb.queue_emit_asmsym(vars[i].namesym,vars[i].namedef);
  1149. { reference to the encoded type }
  1150. tcb.queue_init(voidpointertype);
  1151. tcb.queue_emit_asmsym(vars[i].typesym,vars[i].typedef);
  1152. { alignment -- always 32 bit value }
  1153. tcb.emit_ord_const(vars[i].vf.vardef.alignment,u32inttype);
  1154. { size -- always 32 bit value }
  1155. tcb.emit_ord_const(vars[i].vf.vardef.size,u32inttype);
  1156. end;
  1157. list.concatList(
  1158. tcb.get_final_asmlist(
  1159. ivarslabel,tcb.end_anonymous_record,
  1160. sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint)
  1161. )
  1162. );
  1163. tcb.free;
  1164. end;
  1165. (*
  1166. From Clang:
  1167. /// GetOrEmitProtocol - Generate the protocol meta-data:
  1168. /// @code
  1169. /// struct _protocol_t {
  1170. /// id isa; // NULL
  1171. /// const char * const protocol_name;
  1172. /// const struct _protocol_list_t * protocol_list; // super protocols
  1173. /// const struct method_list_t * const instance_methods;
  1174. /// const struct method_list_t * const class_methods;
  1175. /// const struct method_list_t *optionalInstanceMethods;
  1176. /// const struct method_list_t *optionalClassMethods;
  1177. /// const struct _prop_list_t * properties;
  1178. /// const uint32_t size; // sizeof(struct _protocol_t)
  1179. /// const uint32_t flags; // = 0
  1180. /// }
  1181. /// @endcode
  1182. *)
  1183. procedure tobjcrttiwriter_nonfragile.gen_objc_protocol(list: tasmlist; protocol: tobjectdef; out protocollabel: tasmsymbol);
  1184. var
  1185. lbl,
  1186. listsym : TAsmSymbol;
  1187. namedef : tdef;
  1188. namesym,
  1189. protolist : TAsmLabel;
  1190. reqinstsym,
  1191. reqclssym,
  1192. optinstsym,
  1193. optclssym : TAsmLabel;
  1194. prottype : tdef;
  1195. tcb : ttai_typedconstbuilder;
  1196. begin
  1197. gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist);
  1198. gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym);
  1199. { label for the protocol needs to be
  1200. a) in a coalesced section (so multiple definitions of the same protocol
  1201. can be merged by the linker)
  1202. b) private_extern (should only be merged within the same module)
  1203. c) weakly defined (so multiple definitions don't cause errors)
  1204. }
  1205. prottype:=search_named_unit_globaltype('OBJC','OBJC_PROTOCOL',true).typedef;
  1206. lbl:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcclassrtti),AB_PRIVATE_EXTERN,AT_DATA,prottype);
  1207. protocollabel:=lbl;
  1208. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_weak]);
  1209. tcb.maybe_begin_aggregate(prottype);
  1210. { protocol's isa - always nil }
  1211. tcb.emit_tai(Tai_const.Create_nil_dataptr,objc_idtype);
  1212. { name }
  1213. objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names,namesym,namedef);
  1214. tcb.queue_init(charpointertype);
  1215. tcb.queue_emit_asmsym(namesym,namedef);
  1216. { parent protocols list }
  1217. ConcatSymOrNil(tcb,protolist,voidpointertype);
  1218. { required instance methods }
  1219. ConcatSymOrNil(tcb,reqinstsym,voidpointertype);
  1220. { required class methods }
  1221. ConcatSymOrNil(tcb,reqclssym,voidpointertype);
  1222. { optional instance methods }
  1223. ConcatSymOrNil(tcb,optinstsym,voidpointertype);
  1224. { optional class methods }
  1225. ConcatSymOrNil(tcb,optclssym,voidpointertype);
  1226. { TODO: properties }
  1227. tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
  1228. { size of this type }
  1229. tcb.emit_ord_const(prottype.size,u32inttype);
  1230. { flags }
  1231. tcb.emit_ord_const(0,u32inttype);
  1232. tcb.maybe_end_aggregate(prottype);
  1233. list.concatList(
  1234. tcb.get_final_asmlist(
  1235. lbl,prottype,
  1236. sec_data_coalesced,'_OBJC_PROTOCOL',sizeof(pint)
  1237. )
  1238. );
  1239. tcb.free;
  1240. { also add an entry to the __DATA, __objc_protolist section, required to
  1241. register the protocol with the runtime }
  1242. listsym:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcmetartti),AB_PRIVATE_EXTERN,AT_DATA,cpointerdef.getreusable(prottype));
  1243. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_weak,tcalo_no_dead_strip]);
  1244. tcb.emit_tai(tai_const.Create_sym(lbl),cpointerdef.getreusable(prottype));
  1245. list.concatList(
  1246. tcb.get_final_asmlist(
  1247. listsym,cpointerdef.getreusable(prottype),
  1248. sec_objc_protolist,'_OBJC_PROTOLIST',sizeof(pint)
  1249. )
  1250. );
  1251. tcb.free;
  1252. end;
  1253. (*
  1254. From Clang:
  1255. /// struct _category_t {
  1256. /// const char * const name;
  1257. /// struct _class_t *const cls;
  1258. /// const struct _method_list_t * const instance_methods;
  1259. /// const struct _method_list_t * const class_methods;
  1260. /// const struct _protocol_list_t * const protocols;
  1261. /// const struct _prop_list_t * const properties;
  1262. /// }
  1263. *)
  1264. procedure tobjcrttiwriter_nonfragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol; out catlabeldef: tdef);
  1265. var
  1266. catstrsym,
  1267. protolistsym : TAsmLabel;
  1268. instmthdlist,
  1269. clsmthdlist,
  1270. clssym,
  1271. catsym : TAsmSymbol;
  1272. catstrdef,
  1273. catdef : tdef;
  1274. tcb : ttai_typedconstbuilder;
  1275. begin
  1276. { the category name }
  1277. objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names,catstrsym,catstrdef);
  1278. { the class it extends }
  1279. clssym:=current_asmdata.RefAsmSymbol(objccat.childof.rtti_mangledname(objcclassrtti),AT_DATA);
  1280. { generate the methods lists }
  1281. gen_objc_methods(list,objccat,instmthdlist,false,true);
  1282. gen_objc_methods(list,objccat,clsmthdlist,true,true);
  1283. { generate implemented protocols list }
  1284. gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym);
  1285. { category declaration section }
  1286. tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1287. tcb.begin_anonymous_record(internaltypeprefixName[itb_objc_nf_category],
  1288. C_alignment,1,
  1289. targetinfos[target_info.system]^.alignment.recordalignmin,
  1290. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1291. tcb.queue_init(voidpointertype);
  1292. tcb.queue_emit_asmsym(catstrsym,catstrdef);
  1293. tcb.emit_tai(Tai_const.Create_sym(clssym),voidpointertype);
  1294. ConcatSymOrNil(tcb,instmthdlist,voidpointertype);
  1295. ConcatSymOrNil(tcb,clsmthdlist,voidpointertype);
  1296. ConcatSymOrNil(tcb,protolistsym,voidpointertype);
  1297. { properties, not yet supported }
  1298. tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
  1299. catdef:=tcb.end_anonymous_record;
  1300. catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA,catdef);
  1301. list.concatList(
  1302. tcb.get_final_asmlist(
  1303. catsym,catdef,
  1304. sec_objc_const,'_OBJC_CATEGORY',sizeof(pint)
  1305. )
  1306. );
  1307. tcb.free;
  1308. catlabel:=catsym;
  1309. catlabeldef:=catdef;
  1310. end;
  1311. (*
  1312. From Clang:
  1313. /// BuildIvarLayout - Builds ivar layout bitmap for the class
  1314. /// implementation for the __strong or __weak case.
  1315. /// The layout map displays which words in ivar list must be skipped
  1316. /// and which must be scanned by GC (see below). String is built of bytes.
  1317. /// Each byte is divided up in two nibbles (4-bit each). Left nibble is count
  1318. /// of words to skip and right nibble is count of words to scan. So, each
  1319. /// nibble represents up to 15 workds to skip or scan. Skipping the rest is
  1320. /// represented by a 0x00 byte which also ends the string.
  1321. /// 1. when ForStrongLayout is true, following ivars are scanned:
  1322. /// - id, Class
  1323. /// - object * // note: this "object" means "Objective-C object" (JM)
  1324. /// - __strong anything
  1325. ///
  1326. /// 2. When ForStrongLayout is false, following ivars are scanned:
  1327. /// - __weak anything
  1328. *)
  1329. (*
  1330. Only required when supporting garbage collection
  1331. procedure tobjcrttiwriter_nonfragile.gen_objc_ivargc_recursive(st: tabstractrecordsymtable; ptrbset: tbitset; startoffset: puint; il: tivarlayouttype);
  1332. var
  1333. i: longint;
  1334. fs: tfieldvarsym;
  1335. includelen: longint;
  1336. begin
  1337. for i:=0 to st.SymList.count-1 do
  1338. if (tsym(st.symlist[i]).typ=fieldvarsym) then
  1339. begin
  1340. fs:=tfieldvarsym(st.symlist[i]);
  1341. includelen:=0;
  1342. case fs.vardef.typ of
  1343. pointerdef,
  1344. classrefdef:
  1345. if (fs.vardef=objc_idtype) or
  1346. (fs.vardef=objc_metaclasstype) then
  1347. includelen:=1;
  1348. recorddef:
  1349. TODO: bitpacking -> offset differences
  1350. gen_objc_ivargc_recursive(tabstractrecordsymtable(trecorddef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il);
  1351. arraydef:
  1352. begin
  1353. if not is_special_
  1354. end;
  1355. objectdef :
  1356. begin
  1357. case tobjectdef(fs.vardef).objecttype of
  1358. odt_objcclass,
  1359. odt_objcprotocol:
  1360. includelen:=1;
  1361. odt_object:
  1362. gen_objc_ivargc_recursive(tabstractrecordsymtable(tobjectdef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il);
  1363. end;
  1364. end;
  1365. end;
  1366. end;
  1367. end;
  1368. function tobjcrttiwriter_nonfragile.gen_objc_ivargcstring(objclss: tobjectdef; il: tivarlayouttype): ansistring;
  1369. var
  1370. ptrbset: tbitset;
  1371. parent: tobjectdef;
  1372. size,
  1373. startoffset: puint;
  1374. i: longint;
  1375. begin
  1376. size:=tObjectSymtable(objclss.symtable).datasize;
  1377. if assigned(objclss.childof) then
  1378. startoffset:=tObjectSymtable(objclss.childof.symtable).datasize
  1379. else
  1380. startoffset:=0;
  1381. size:=size-startoffset;
  1382. ptrbset:=tbitset.create_bytesize((size+sizeof(ptruint)-1) div sizeof(ptruint));
  1383. { has to include info for this class' fields and those of all parent
  1384. classes as well
  1385. }
  1386. parent:=obclss;
  1387. repeat
  1388. gen_objc_ivargc_recursive(parent.symtable,ptrbset,0,il);
  1389. parent:=parent.childof;
  1390. until not assigned(parent);
  1391. { convert bits set to encoded string }
  1392. end;
  1393. *)
  1394. (*
  1395. From Clang:
  1396. /// struct _class_ro_t {
  1397. /// uint32_t const flags;
  1398. /// uint32_t const instanceStart;
  1399. /// uint32_t const instanceSize;
  1400. /// uint32_t const reserved; // only when building for 64bit targets
  1401. /// const uint8_t * const ivarLayout;
  1402. /// const char *const name;
  1403. /// const struct _method_list_t * const baseMethods;
  1404. /// const struct _protocol_list_t *const baseProtocols;
  1405. /// const struct _ivar_list_t *const ivars;
  1406. /// const uint8_t * const weakIvarLayout;
  1407. /// const struct _prop_list_t * const properties;
  1408. /// }
  1409. *)
  1410. procedure tobjcrttiwriter_nonfragile.gen_objc_class_ro_part(list: tasmlist; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: tasmsymbol; metaclass: boolean);
  1411. const
  1412. CLS_CLASS = 0;
  1413. CLS_META = 1;
  1414. CLS_ROOT = 2;
  1415. OBJC2_CLS_HIDDEN = $10;
  1416. CLS_EXCEPTION = $20;
  1417. var
  1418. methodssym,
  1419. rosym : TAsmSymbol;
  1420. classStrDef : tdef;
  1421. classStrSym,
  1422. ivarslab : TAsmLabel;
  1423. rodef,
  1424. class_type : tdef;
  1425. start,
  1426. size,
  1427. flags : cardinal;
  1428. rttitype : trttitype;
  1429. firstfield : tfieldvarsym;
  1430. i : longint;
  1431. tcb : ttai_typedconstbuilder;
  1432. begin
  1433. { consider every class declared in the implementation section of a unit
  1434. as "hidden"
  1435. }
  1436. flags:=0;
  1437. if (objclss.owner.symtabletype=staticsymtable) and
  1438. current_module.is_unit then
  1439. flags:=OBJC2_CLS_HIDDEN;
  1440. if metaclass then
  1441. begin
  1442. flags:=flags or CLS_META;
  1443. rttitype:=objcmetarortti;
  1444. { metaclass size/start: always size of objc_object }
  1445. class_type:=search_named_unit_globaltype('OBJC','OBJC_OBJECT',true).typedef;
  1446. start:=class_type.size;
  1447. size:=start;
  1448. end
  1449. else
  1450. begin
  1451. flags:=flags or CLS_CLASS;
  1452. rttitype:=objcclassrortti;
  1453. size:=tObjectSymtable(objclss.symtable).datasize;
  1454. { can't simply use childof's datasize, because alignment may cause the
  1455. first field to skip a couple of bytes after the previous end }
  1456. firstfield:=nil;
  1457. for i:=0 to objclss.symtable.SymList.Count-1 do
  1458. if (tsym(objclss.symtable.SymList[i]).typ=fieldvarsym) then
  1459. begin
  1460. firstfield:=tfieldvarsym(objclss.symtable.SymList[i]);
  1461. break;
  1462. end;
  1463. if assigned(firstfield) then
  1464. start:=firstfield.fieldoffset
  1465. else
  1466. { no extra fields -> start = size }
  1467. start:=size;
  1468. end;
  1469. if not assigned(objclss.childof) then
  1470. flags:=flags or CLS_ROOT;
  1471. objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names,classStrSym,classStrDef);
  1472. { generate methods list }
  1473. gen_objc_methods(list,objclss,methodssym,metaclass,false);
  1474. { generate ivars (nil for metaclass) }
  1475. if metaclass then
  1476. ivarslab:=nil
  1477. else
  1478. gen_objc_ivars(list,objclss,ivarslab);
  1479. { class declaration section }
  1480. tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1481. tcb.begin_anonymous_record(
  1482. internaltypeprefixName[itb_objc_nf_class_ro_part],
  1483. C_alignment,1,
  1484. targetinfos[target_info.system]^.alignment.recordalignmin,
  1485. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1486. tcb.emit_ord_const(flags,u32inttype);
  1487. tcb.emit_ord_const(start,u32inttype);
  1488. tcb.emit_ord_const(size,u32inttype);
  1489. { strong ivar layout for garbage collection (deprecated) }
  1490. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  1491. tcb.queue_init(voidpointertype);
  1492. tcb.queue_emit_asmsym(classStrSym,classStrDef);
  1493. ConcatSymOrNil(tcb,methodssym,voidpointertype);
  1494. ConcatSymOrNil(tcb,protolistsym,voidpointertype);
  1495. ConcatSymOrNil(tcb,ivarslab,voidpointertype);
  1496. { weak ivar layout for garbage collection (deprecated) }
  1497. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  1498. { TODO: properties }
  1499. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  1500. rodef:=tcb.end_anonymous_record;
  1501. rosym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(rttitype),AB_LOCAL,AT_DATA,rodef);
  1502. list.concatList(
  1503. tcb.get_final_asmlist(
  1504. rosym,rodef,
  1505. sec_objc_const,'_OBJC_META_CLASS',sizeof(pint)
  1506. )
  1507. );
  1508. tcb.free;
  1509. classrolabel:=rosym;
  1510. end;
  1511. (*
  1512. From Clang:
  1513. /// struct _class_t {
  1514. /// struct _class_t *isa;
  1515. /// struct _class_t * const superclass;
  1516. /// void *cache;
  1517. /// IMP *vtable;
  1518. /// struct class_ro_t *ro;
  1519. /// }
  1520. ///
  1521. *)
  1522. { Generate rtti for an Objective-C class and its meta-class. }
  1523. procedure tobjcrttiwriter_nonfragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol; out classlabeldef: tdef);
  1524. var
  1525. root : tobjectdef;
  1526. superSym,
  1527. superMetaSym,
  1528. metaisaSym,
  1529. metasym,
  1530. clssym,
  1531. metarosym,
  1532. rosym : TAsmSymbol;
  1533. protolistsym : TAsmLabel;
  1534. vis : TAsmsymbind;
  1535. isatcb,
  1536. metatcb : ttai_typedconstbuilder;
  1537. metadef,
  1538. classdef : tdef;
  1539. begin
  1540. { A) Register necessary names }
  1541. { 1) the current class and metaclass }
  1542. if (objclss.owner.symtabletype=globalsymtable) then
  1543. vis:=AB_GLOBAL
  1544. else
  1545. vis:=AB_PRIVATE_EXTERN;
  1546. { create the typed const builders so we can get the (provisional) types
  1547. for the class and metaclass symbols }
  1548. isatcb:=ctai_typedconstbuilder.create([]);
  1549. classdef:=isatcb.begin_anonymous_record(
  1550. internaltypeprefixName[itb_objc_nf_class],
  1551. C_alignment,1,
  1552. targetinfos[target_info.system]^.alignment.recordalignmin,
  1553. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1554. metatcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1555. metadef:=metatcb.begin_anonymous_record(
  1556. internaltypeprefixName[itb_objc_nf_meta_class],
  1557. C_alignment,1,
  1558. targetinfos[target_info.system]^.alignment.recordalignmin,
  1559. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1560. clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),vis,AT_DATA,classdef);
  1561. metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),vis,AT_DATA,metadef);
  1562. { 2) the superclass and meta superclass }
  1563. if assigned(objclss.childof) then
  1564. begin
  1565. superSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcclassrtti),AT_DATA);
  1566. superMetaSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcmetartti),AT_DATA);
  1567. end
  1568. else
  1569. begin
  1570. superSym:=nil;
  1571. { the class itself }
  1572. superMetaSym:=clssym;
  1573. end;
  1574. { 3) the isa }
  1575. { From Clang: The isa for the meta-class is the root of the hierarchy. }
  1576. root:=objclss;
  1577. while assigned(root.childof) do
  1578. root:=root.childof;
  1579. metaisaSym:=current_asmdata.RefAsmSymbol(root.rtti_mangledname(objcmetartti),AT_DATA);
  1580. { 4) the implemented protocols (same for metaclass and regular class) }
  1581. gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym);
  1582. { 5) the read-only parts of the class definitions }
  1583. gen_objc_class_ro_part(list,objclss,protolistsym,metarosym,true);
  1584. gen_objc_class_ro_part(list,objclss,protolistsym,rosym,false);
  1585. { B) Class declaration section }
  1586. { both class and metaclass are in the objc_data section for obj-c 2 }
  1587. { 1) meta-class declaration }
  1588. { the isa }
  1589. metatcb.emit_tai(Tai_const.Create_sym(metaisaSym),voidpointertype);
  1590. { the superclass }
  1591. metatcb.emit_tai(Tai_const.Create_sym(superMetaSym),voidpointertype);
  1592. { pointer to cache }
  1593. if not assigned(ObjCEmptyCacheVar) then
  1594. ObjCEmptyCacheVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_cache',AT_DATA);
  1595. metatcb.emit_tai(Tai_const.Create_sym(ObjCEmptyCacheVar),voidpointertype);
  1596. { pointer to vtable }
  1597. if not assigned(ObjCEmptyVtableVar) and
  1598. not(target_info.system in [system_arm_darwin,system_aarch64_darwin,system_i386_iphonesim,system_x86_64_iphonesim]) then
  1599. ObjCEmptyVtableVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_vtable',AT_DATA);
  1600. ConcatSymOrNil(metatcb,ObjCEmptyVtableVar,voidpointertype);
  1601. { the read-only part }
  1602. metatcb.emit_tai(Tai_const.Create_sym(metarosym),voidpointertype);
  1603. metatcb.end_anonymous_record;
  1604. list.concatList(
  1605. metatcb.get_final_asmlist(
  1606. metasym,metadef,
  1607. sec_objc_data,'_OBJC_CLASS',sizeof(pint)
  1608. )
  1609. );
  1610. metatcb.free;
  1611. { 2) regular class declaration }
  1612. { the isa }
  1613. isatcb.emit_tai(Tai_const.Create_sym(metasym),cpointerdef.getreusable(metadef));
  1614. { the superclass }
  1615. ConcatSymOrNil(isatcb,supersym,voidpointertype);
  1616. { pointer to cache }
  1617. isatcb.emit_tai(Tai_const.Create_sym(ObjCEmptyCacheVar),voidpointertype);
  1618. { pointer to vtable }
  1619. ConcatSymOrNil(isatcb,ObjCEmptyVtableVar,voidpointertype);
  1620. { the read-only part }
  1621. isatcb.emit_tai(Tai_const.Create_sym(rosym),voidpointertype);
  1622. isatcb.end_anonymous_record;
  1623. list.concatList(
  1624. isatcb.get_final_asmlist(
  1625. clssym,classdef,
  1626. sec_objc_data,'_OBJC_CLASS',sizeof(pint)
  1627. )
  1628. );
  1629. isatcb.free;
  1630. classlabel:=clssym;
  1631. classlabeldef:=classdef;;
  1632. end;
  1633. procedure tobjcrttiwriter_nonfragile.addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist);
  1634. var
  1635. i: longint;
  1636. sym: TAsmSymbol;
  1637. tcb: ttai_typedconstbuilder;
  1638. arrdef: tdef;
  1639. begin
  1640. if classes.count=0 then
  1641. exit;
  1642. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  1643. arrdef:=carraydef.getreusable(voidpointertype,classes.count);
  1644. sym:=current_asmdata.DefineAsmSymbol(symname,AB_LOCAL,AT_DATA,arrdef);
  1645. tcb.maybe_begin_aggregate(arrdef);
  1646. for i:=0 to classes.count-1 do
  1647. tcb.emit_tai(
  1648. tai_const.Create_sym(current_asmdata.RefAsmSymbol(tobjectdef(classes[i]).rtti_mangledname(objcclassrtti),AT_DATA)),
  1649. voidpointertype
  1650. );
  1651. tcb.maybe_end_aggregate(arrdef);
  1652. list.concatList(
  1653. tcb.get_final_asmlist(
  1654. sym,arrdef,
  1655. section,symname,sizeof(pint)
  1656. )
  1657. );
  1658. end;
  1659. procedure tobjcrttiwriter_nonfragile.gen_objc_info_sections(list: tasmlist);
  1660. function collectnonlazyclasses(classes: tfpobjectlist): tfpobjectlist;
  1661. var
  1662. symentry : tsym;
  1663. procdef : tprocdef;
  1664. i,j : longint;
  1665. begin
  1666. { non-lazy classes are all classes that define a class method with the
  1667. selector called "load" (simply inheriting this class method is not enough,
  1668. they have to implement it themselves)
  1669. -- TODO: this currently only works if the Pascal identifier is also 'load'! }
  1670. result:=tfpobjectlist.create(false);
  1671. for i:=0 to classes.count-1 do
  1672. begin
  1673. symentry:=tsym(tobjectsymtable(tobjectdef(classes[i]).symtable).find('LOAD'));
  1674. if assigned(symentry) and
  1675. (symentry.typ=procsym) then
  1676. begin
  1677. for j:=0 to tprocsym(symentry).ProcdefList.count do
  1678. begin
  1679. procdef:=tprocdef(tprocsym(symentry).ProcdefList[0]);
  1680. if ((po_classmethod in procdef.procoptions) and
  1681. (procdef.messageinf.str^='load')) then
  1682. begin
  1683. result.add(classes[i]);
  1684. break;
  1685. end;
  1686. end;
  1687. end;
  1688. end;
  1689. end;
  1690. var
  1691. nonlazyclasses,
  1692. nonlazycategories : tfpobjectlist;
  1693. begin
  1694. if (classdefs.count=0) and
  1695. (catdefs.count=0) then
  1696. exit;
  1697. nonlazyclasses:=collectnonlazyclasses(classdefs);
  1698. nonlazycategories:=collectnonlazyclasses(catdefs);
  1699. { this list has to include all classes, also the non-lazy ones }
  1700. addclasslist(list,sec_objc_classlist,target_asm.labelprefix+'_OBJC_LABEL_CLASS_$',classdefs);
  1701. addclasslist(list,sec_objc_nlclasslist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CLASS_$',nonlazyclasses);
  1702. { category and non-lazy category lists }
  1703. addclasslist(list,sec_objc_catlist,target_asm.labelprefix+'_OBJC_LABEL_CATEGORY_$',catdefs);
  1704. addclasslist(list,sec_objc_nlcatlist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CATEGORY_$',nonlazycategories);
  1705. nonlazyclasses.free;
  1706. nonlazycategories.free;
  1707. { the non-fragile abi doesn't have any module info, nor lazy references
  1708. to used classes or to parent classes }
  1709. end;
  1710. constructor tobjcrttiwriter_nonfragile.create;
  1711. begin
  1712. inherited create(oa_nonfragile);
  1713. end;
  1714. {******************************************************************
  1715. RTTI generation -- Main function
  1716. *******************************************************************}
  1717. procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable);
  1718. var
  1719. objcrttiwriter: tobjcrttiwriter;
  1720. tcb: ttai_typedconstbuilder;
  1721. begin
  1722. if (m_objectivec1 in current_settings.modeswitches) then
  1723. begin
  1724. { first 4 bytes contain version information about this section (currently version 0),
  1725. next 4 bytes contain flags (currently only regarding whether the code in the object
  1726. file supports or requires garbage collection)
  1727. }
  1728. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
  1729. tcb.emit_ord_const(0,u64inttype);
  1730. current_asmdata.asmlists[al_objc_data].concatList(
  1731. tcb.get_final_asmlist(
  1732. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_IMAGE_INFO',AB_LOCAL,AT_DATA,u64inttype),
  1733. u64inttype,sec_objc_image_info,'_OBJC_IMAGE_INFO',sizeof(pint)
  1734. )
  1735. );
  1736. tcb.free;
  1737. { generate rtti for all obj-c classes, protocols and categories
  1738. defined in this module. }
  1739. if not(target_info.system in systems_objc_nfabi) then
  1740. objcrttiwriter:=tobjcrttiwriter_fragile.create
  1741. else
  1742. objcrttiwriter:=tobjcrttiwriter_nonfragile.create;
  1743. objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],globalst);
  1744. objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],localst);
  1745. objcrttiwriter.gen_objc_info_sections(current_asmdata.asmlists[al_objc_data]);
  1746. objcrttiwriter.free;
  1747. end;
  1748. end;
  1749. end.