objcgutl.pas 68 KB

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