ncgrtti.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Routines for the code generation of RTTI data structures
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ncgrtti;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,constexp,
  22. aasmbase,
  23. symbase,symconst,symtype,symdef;
  24. type
  25. { TRTTIWriter }
  26. TRTTIWriter=class
  27. private
  28. procedure fields_write_rtti(st:tsymtable;rt:trttitype);
  29. procedure params_write_rtti(def:tabstractprocdef;rt:trttitype);
  30. procedure fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype);
  31. procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
  32. procedure published_write_rtti(st:tsymtable;rt:trttitype);
  33. function published_properties_count(st:tsymtable):longint;
  34. procedure published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable);
  35. procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
  36. function ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
  37. procedure write_rtti_name(def:tdef);
  38. procedure write_rtti_data(def:tdef;rt:trttitype);
  39. procedure write_child_rtti_data(def:tdef;rt:trttitype);
  40. procedure write_rtti_reference(def:tdef;rt:trttitype);
  41. procedure write_header(def: tdef; typekind: byte);
  42. procedure write_string(const s: string);
  43. procedure maybe_write_align;
  44. public
  45. procedure write_rtti(def:tdef;rt:trttitype);
  46. function get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
  47. function get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
  48. function get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
  49. end;
  50. var
  51. RTTIWriter : TRTTIWriter;
  52. implementation
  53. uses
  54. cutils,
  55. globals,globtype,verbose,systems,
  56. fmodule, procinfo,
  57. symsym,
  58. aasmtai,aasmdata,
  59. defutil,
  60. wpobase
  61. ;
  62. const
  63. rttidefstate : array[trttitype] of tdefstate =
  64. (ds_rtti_table_written,ds_init_table_written,
  65. { Objective-C related, does not pass here }
  66. symconst.ds_none,symconst.ds_none,
  67. symconst.ds_none,symconst.ds_none);
  68. type
  69. TPropNameListItem = class(TFPHashObject)
  70. propindex : longint;
  71. propowner : TSymtable;
  72. end;
  73. {***************************************************************************
  74. TRTTIWriter
  75. ***************************************************************************}
  76. procedure TRTTIWriter.maybe_write_align;
  77. begin
  78. if (tf_requires_proper_alignment in target_info.flags) then
  79. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  80. end;
  81. procedure TRTTIWriter.write_string(const s: string);
  82. begin
  83. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(s)));
  84. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(s));
  85. end;
  86. procedure TRTTIWriter.write_header(def: tdef; typekind: byte);
  87. begin
  88. if def.typ=arraydef then
  89. InternalError(201012211);
  90. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(typekind));
  91. if assigned(def.typesym) then
  92. write_string(ttypesym(def.typesym).realname)
  93. else
  94. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0));
  95. end;
  96. procedure TRTTIWriter.write_rtti_name(def:tdef);
  97. var
  98. hs : string;
  99. begin
  100. if is_open_array(def) then
  101. { open arrays never have a typesym with a name, since you cannot
  102. define an "open array type". Kylix prints the type of the
  103. elements in the array in this case (so together with the pfArray
  104. flag, you can reconstruct the full typename, I assume (JM))
  105. }
  106. def:=tarraydef(def).elementdef;
  107. { name }
  108. if assigned(def.typesym) then
  109. begin
  110. hs:=ttypesym(def.typesym).realname;
  111. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(chr(length(hs))+hs));
  112. end
  113. else
  114. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0));
  115. end;
  116. { writes a 32-bit count followed by array of field infos for given symtable }
  117. procedure TRTTIWriter.fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype);
  118. var
  119. i : longint;
  120. sym : tsym;
  121. fieldcnt: longint;
  122. lastai: TLinkedListItem;
  123. st: tsymtable;
  124. offset : asizeint;
  125. begin
  126. fieldcnt:=0;
  127. { Count will be inserted at this location. It cannot be nil as we've just
  128. written header for this symtable owner. But stay safe. }
  129. lastai:=current_asmdata.asmlists[al_rtti].last;
  130. if lastai=nil then
  131. InternalError(201012212);
  132. { For objects, treat parent (if any) as a field with offset 0. This
  133. provides correct handling of entire instance with RTL rtti routines. }
  134. if (def.typ=objectdef) and (tobjectdef(def).objecttype=odt_object) and
  135. Assigned(tobjectdef(def).childof) and
  136. ((rt=fullrtti) or (tobjectdef(def).childof.needs_inittable)) then
  137. begin
  138. write_rtti_reference(tobjectdef(def).childof,rt);
  139. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(0));
  140. inc(fieldcnt);
  141. end;
  142. st:=def.symtable;
  143. for i:=0 to st.SymList.Count-1 do
  144. begin
  145. sym:=tsym(st.SymList[i]);
  146. if (tsym(sym).typ=fieldvarsym) and
  147. not(sp_static in tsym(sym).symoptions) and
  148. (
  149. (rt=fullrtti) or
  150. tfieldvarsym(sym).vardef.needs_inittable
  151. ) and
  152. not is_objc_class_or_protocol(tfieldvarsym(sym).vardef) then
  153. begin
  154. write_rtti_reference(tfieldvarsym(sym).vardef,rt);
  155. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(tfieldvarsym(sym).fieldoffset));
  156. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ord(vo_is_weakref in tfieldvarsym(sym).varoptions)));
  157. maybe_write_align;
  158. inc(fieldcnt);
  159. end;
  160. end;
  161. { insert field count before data }
  162. current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_32bit(fieldcnt),lastai)
  163. end;
  164. procedure TRTTIWriter.fields_write_rtti(st:tsymtable;rt:trttitype);
  165. var
  166. i : longint;
  167. sym : tsym;
  168. begin
  169. for i:=0 to st.SymList.Count-1 do
  170. begin
  171. sym:=tsym(st.SymList[i]);
  172. if (tsym(sym).typ=fieldvarsym) and
  173. not(sp_static in tsym(sym).symoptions) and
  174. (
  175. (rt=fullrtti) or
  176. tfieldvarsym(sym).vardef.needs_inittable
  177. ) then
  178. write_rtti(tfieldvarsym(sym).vardef,rt);
  179. end;
  180. end;
  181. procedure TRTTIWriter.params_write_rtti(def:tabstractprocdef;rt:trttitype);
  182. var
  183. i : longint;
  184. sym : tparavarsym;
  185. begin
  186. for i:=0 to def.paras.count-1 do
  187. begin
  188. sym:=tparavarsym(def.paras[i]);
  189. if not (vo_is_hidden_para in sym.varoptions) then
  190. write_rtti(sym.vardef,rt);
  191. end;
  192. end;
  193. procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype);
  194. var
  195. i : longint;
  196. sym : tsym;
  197. begin
  198. for i:=0 to st.SymList.Count-1 do
  199. begin
  200. sym:=tsym(st.SymList[i]);
  201. if (sym.visibility=vis_published) then
  202. begin
  203. case tsym(sym).typ of
  204. propertysym:
  205. write_rtti(tpropertysym(sym).propdef,rt);
  206. fieldvarsym:
  207. write_rtti(tfieldvarsym(sym).vardef,rt);
  208. end;
  209. end;
  210. end;
  211. end;
  212. function TRTTIWriter.published_properties_count(st:tsymtable):longint;
  213. var
  214. i : longint;
  215. sym : tsym;
  216. begin
  217. result:=0;
  218. for i:=0 to st.SymList.Count-1 do
  219. begin
  220. sym:=tsym(st.SymList[i]);
  221. if (tsym(sym).typ=propertysym) and
  222. (sym.visibility=vis_published) then
  223. inc(result);
  224. end;
  225. end;
  226. procedure TRTTIWriter.collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
  227. var
  228. i : longint;
  229. sym : tsym;
  230. pn : tpropnamelistitem;
  231. begin
  232. if assigned(objdef.childof) then
  233. collect_propnamelist(propnamelist,objdef.childof);
  234. for i:=0 to objdef.symtable.SymList.Count-1 do
  235. begin
  236. sym:=tsym(objdef.symtable.SymList[i]);
  237. if (tsym(sym).typ=propertysym) and
  238. (sym.visibility=vis_published) then
  239. begin
  240. pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name));
  241. if not assigned(pn) then
  242. begin
  243. pn:=tpropnamelistitem.create(propnamelist,tsym(sym).name);
  244. pn.propindex:=propnamelist.count-1;
  245. pn.propowner:=tsym(sym).owner;
  246. end;
  247. end;
  248. end;
  249. end;
  250. procedure TRTTIWriter.published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable);
  251. var
  252. i : longint;
  253. sym : tsym;
  254. proctypesinfo : byte;
  255. propnameitem : tpropnamelistitem;
  256. procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
  257. var
  258. typvalue : byte;
  259. hp : ppropaccesslistitem;
  260. address,space : longint;
  261. def : tdef;
  262. hpropsym : tpropertysym;
  263. propaccesslist : tpropaccesslist;
  264. begin
  265. hpropsym:=tpropertysym(sym);
  266. repeat
  267. propaccesslist:=hpropsym.propaccesslist[pap];
  268. if not propaccesslist.empty then
  269. break;
  270. hpropsym:=hpropsym.overriddenpropsym;
  271. until not assigned(hpropsym);
  272. if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym)) then
  273. begin
  274. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_int_codeptr(unsetvalue));
  275. typvalue:=3;
  276. end
  277. else if propaccesslist.firstsym^.sym.typ=fieldvarsym then
  278. begin
  279. address:=0;
  280. hp:=propaccesslist.firstsym;
  281. def:=nil;
  282. while assigned(hp) do
  283. begin
  284. case hp^.sltype of
  285. sl_load :
  286. begin
  287. def:=tfieldvarsym(hp^.sym).vardef;
  288. inc(address,tfieldvarsym(hp^.sym).fieldoffset);
  289. end;
  290. sl_subscript :
  291. begin
  292. if not(assigned(def) and
  293. ((def.typ=recorddef) or
  294. is_object(def))) then
  295. internalerror(200402171);
  296. inc(address,tfieldvarsym(hp^.sym).fieldoffset);
  297. def:=tfieldvarsym(hp^.sym).vardef;
  298. end;
  299. sl_vec :
  300. begin
  301. if not(assigned(def) and (def.typ=arraydef)) then
  302. internalerror(200402172);
  303. def:=tarraydef(def).elementdef;
  304. {Hp.value is a Tconstexprint, which can be rather large,
  305. sanity check for longint overflow.}
  306. space:=(high(address)-address) div def.size;
  307. if int64(space)<hp^.value then
  308. internalerror(200706101);
  309. inc(address,int64(def.size*hp^.value));
  310. end;
  311. end;
  312. hp:=hp^.next;
  313. end;
  314. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_int_codeptr(address));
  315. typvalue:=0;
  316. end
  317. else
  318. begin
  319. { When there was an error then procdef is not assigned }
  320. if not assigned(propaccesslist.procdef) then
  321. exit;
  322. if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) or
  323. is_objectpascal_helper(tprocdef(propaccesslist.procdef).struct) then
  324. begin
  325. current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,AT_FUNCTION,0));
  326. typvalue:=1;
  327. end
  328. else
  329. begin
  330. { virtual method, write vmt offset }
  331. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_int_codeptr(
  332. tobjectdef(tprocdef(propaccesslist.procdef).struct).vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
  333. { register for wpo }
  334. tobjectdef(tprocdef(propaccesslist.procdef).struct).register_vmt_call(tprocdef(propaccesslist.procdef).extnumber);
  335. {$ifdef vtentry}
  336. { not sure if we can insert those vtentry symbols safely here }
  337. {$error register methods used for published properties}
  338. {$endif vtentry}
  339. typvalue:=2;
  340. end;
  341. end;
  342. proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
  343. end;
  344. begin
  345. for i:=0 to st.SymList.Count-1 do
  346. begin
  347. sym:=tsym(st.SymList[i]);
  348. if (sym.typ=propertysym) and
  349. (sym.visibility=vis_published) then
  350. begin
  351. if ppo_indexed in tpropertysym(sym).propoptions then
  352. proctypesinfo:=$40
  353. else
  354. proctypesinfo:=0;
  355. write_rtti_reference(tpropertysym(sym).propdef,fullrtti);
  356. writeaccessproc(palt_read,0,0);
  357. writeaccessproc(palt_write,2,0);
  358. { is it stored ? }
  359. if not(ppo_stored in tpropertysym(sym).propoptions) then
  360. begin
  361. { no, so put a constant zero }
  362. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_codeptr);
  363. proctypesinfo:=proctypesinfo or (3 shl 4);
  364. end
  365. else
  366. writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
  367. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index));
  368. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default));
  369. propnameitem:=TPropNameListItem(propnamelist.Find(tpropertysym(sym).name));
  370. if not assigned(propnameitem) then
  371. internalerror(200512201);
  372. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnameitem.propindex));
  373. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo));
  374. write_string(tpropertysym(sym).realname);
  375. maybe_write_align;
  376. end;
  377. end;
  378. end;
  379. procedure TRTTIWriter.write_rtti_data(def:tdef;rt:trttitype);
  380. procedure unknown_rtti(def:tstoreddef);
  381. begin
  382. current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
  383. write_rtti_name(def);
  384. end;
  385. procedure variantdef_rtti(def:tvariantdef);
  386. begin
  387. write_header(def,tkVariant);
  388. end;
  389. procedure stringdef_rtti(def:tstringdef);
  390. begin
  391. case def.stringtype of
  392. st_ansistring:
  393. begin
  394. write_header(def,tkAString);
  395. maybe_write_align;
  396. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.encoding));
  397. end;
  398. st_widestring:
  399. write_header(def,tkWString);
  400. st_unicodestring:
  401. write_header(def,tkUString);
  402. st_longstring:
  403. write_header(def,tkLString);
  404. st_shortstring:
  405. begin
  406. write_header(def,tkSString);
  407. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.len));
  408. maybe_write_align; // is align necessary here?
  409. end;
  410. end;
  411. end;
  412. procedure enumdef_rtti(def:tenumdef);
  413. var
  414. i : integer;
  415. hp : tenumsym;
  416. begin
  417. write_header(def,tkEnumeration);
  418. maybe_write_align;
  419. case longint(def.size) of
  420. 1 :
  421. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
  422. 2 :
  423. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
  424. 4 :
  425. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
  426. end;
  427. { we need to align by Tconstptruint here to satisfy the alignment rules set by
  428. records: in the typinfo unit we overlay a TTypeData record on this data, which at
  429. the innermost variant record needs an alignment of TConstPtrUint due to e.g.
  430. the "CompType" member for tkSet (also the "BaseType" member for tkEnumeration).
  431. We need to adhere to this, otherwise things will break.
  432. Note that other code (e.g. enumdef_rtti_calcstringtablestart()) relies on the
  433. exact sequence too. }
  434. maybe_write_align;
  435. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min));
  436. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max));
  437. maybe_write_align; // is align necessary here?
  438. { write base type }
  439. write_rtti_reference(def.basedef,rt);
  440. for i := 0 to def.symtable.SymList.Count - 1 do
  441. begin
  442. hp:=tenumsym(def.symtable.SymList[i]);
  443. if hp.value<def.minval then
  444. continue
  445. else
  446. if hp.value>def.maxval then
  447. break;
  448. write_string(hp.realname);
  449. end;
  450. { write unit name }
  451. write_string(current_module.realmodulename^);
  452. { write zero which is required by RTL }
  453. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
  454. end;
  455. procedure orddef_rtti(def:torddef);
  456. procedure dointeger(typekind: byte);
  457. const
  458. trans : array[tordtype] of byte =
  459. (otUByte{otNone},
  460. otUByte,otUWord,otULong,otUByte{otNone},
  461. otSByte,otSWord,otSLong,otUByte{otNone},
  462. otUByte,otUWord,otULong,otUByte,
  463. otSByte,otSWord,otSLong,otSByte,
  464. otUByte,otUWord,otUByte);
  465. begin
  466. write_header(def,typekind);
  467. maybe_write_align;
  468. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype])));
  469. maybe_write_align;
  470. {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
  471. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low.svalue)));
  472. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high.svalue)));
  473. end;
  474. begin
  475. case def.ordtype of
  476. s64bit :
  477. begin
  478. write_header(def,tkInt64);
  479. maybe_write_align;
  480. { low }
  481. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
  482. { high }
  483. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
  484. end;
  485. u64bit :
  486. begin
  487. write_header(def,tkQWord);
  488. maybe_write_align;
  489. {use svalue because Create_64bit accepts int64, prevents range checks}
  490. { low }
  491. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
  492. { high }
  493. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
  494. end;
  495. pasbool8:
  496. dointeger(tkBool);
  497. uchar:
  498. dointeger(tkChar);
  499. uwidechar:
  500. dointeger(tkWChar);
  501. scurrency:
  502. begin
  503. write_header(def,tkFloat);
  504. maybe_write_align;
  505. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ftCurr));
  506. end;
  507. else
  508. dointeger(tkInteger);
  509. end;
  510. end;
  511. procedure floatdef_rtti(def:tfloatdef);
  512. const
  513. {tfloattype = (s32real,s64real,s80real,sc80real,s64bit,s128bit);}
  514. translate : array[tfloattype] of byte =
  515. (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
  516. begin
  517. write_header(def,tkFloat);
  518. maybe_write_align;
  519. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[def.floattype]));
  520. end;
  521. procedure setdef_rtti(def:tsetdef);
  522. begin
  523. write_header(def,tkSet);
  524. maybe_write_align;
  525. case def.size of
  526. 1:
  527. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
  528. 2:
  529. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
  530. 4:
  531. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
  532. else
  533. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
  534. end;
  535. maybe_write_align;
  536. write_rtti_reference(def.elementdef,rt);
  537. end;
  538. procedure arraydef_rtti(def:tarraydef);
  539. var
  540. lastai: TLinkedListItem;
  541. dimcount: byte;
  542. totalcount: asizeuint;
  543. curdef:tarraydef;
  544. begin
  545. if ado_IsDynamicArray in def.arrayoptions then
  546. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
  547. else
  548. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
  549. write_rtti_name(def);
  550. maybe_write_align;
  551. if not(ado_IsDynamicArray in def.arrayoptions) then
  552. begin
  553. { remember tha last instruction. we will need to insert some
  554. calculated values after it }
  555. lastai:=current_asmdata.asmlists[al_rtti].last;
  556. curdef:=def;
  557. totalcount:=1;
  558. dimcount:=0;
  559. while assigned(curdef) do
  560. begin
  561. { Dims[i] PTypeInfo }
  562. write_rtti_reference(curdef.rangedef,rt);
  563. inc(dimcount);
  564. totalcount:=totalcount*curdef.elecount;
  565. { get the next static array }
  566. if assigned(curdef.elementdef) and
  567. (curdef.elementdef.typ=arraydef) and
  568. not(ado_IsDynamicArray in tarraydef(curdef.elementdef).arrayoptions) then
  569. curdef:=tarraydef(curdef.elementdef)
  570. else
  571. break;
  572. end;
  573. if (tf_requires_proper_alignment in target_info.flags) then
  574. current_asmdata.asmlists[al_rtti].InsertAfter(cai_align.Create(sizeof(TConstPtrUInt)),lastai);
  575. { dimension count }
  576. current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_8bit(dimcount),lastai);
  577. { last dimension element type }
  578. current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_sym(ref_rtti(curdef.elementdef,rt)),lastai);
  579. { total element count }
  580. current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_pint(pint(totalcount)),lastai);
  581. { total size = elecount * elesize of the first arraydef }
  582. current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_pint(def.elecount*def.elesize),lastai);
  583. end
  584. else
  585. { write a delphi almost compatible dyn. array entry:
  586. there are two types, eltype and eltype2, the latter is nil if the element type needs
  587. no finalization, the former is always valid, delphi has this swapped, but for
  588. compatibility with older fpc versions we do it different, to be delphi compatible,
  589. the names are swapped in typinfo.pp
  590. }
  591. begin
  592. { size of elements }
  593. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize));
  594. { element type }
  595. write_rtti_reference(def.elementdef,rt);
  596. { variant type }
  597. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
  598. { element type }
  599. if def.elementdef.needs_inittable then
  600. write_rtti_reference(def.elementdef,rt)
  601. else
  602. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_dataptr);
  603. { write unit name }
  604. write_string(current_module.realmodulename^);
  605. end;
  606. end;
  607. procedure classrefdef_rtti(def:tclassrefdef);
  608. begin
  609. write_header(def,tkClassRef);
  610. maybe_write_align;
  611. write_rtti_reference(def.pointeddef,rt);
  612. end;
  613. procedure pointerdef_rtti(def:tpointerdef);
  614. begin
  615. write_header(def,tkPointer);
  616. maybe_write_align;
  617. write_rtti_reference(def.pointeddef,rt);
  618. end;
  619. procedure recorddef_rtti(def:trecorddef);
  620. begin
  621. write_header(def,tkRecord);
  622. maybe_write_align;
  623. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  624. fields_write_rtti_data(def,rt);
  625. end;
  626. procedure procvardef_rtti(def:tprocvardef);
  627. const
  628. ProcCallOptionToCallConv: array[tproccalloption] of byte = (
  629. { pocall_none } 0,
  630. { pocall_cdecl } 1,
  631. { pocall_cppdecl } 5,
  632. { pocall_far16 } 6,
  633. { pocall_oldfpccall } 7,
  634. { pocall_internproc } 8,
  635. { pocall_syscall } 9,
  636. { pocall_pascal } 2,
  637. { pocall_register } 0,
  638. { pocall_safecall } 4,
  639. { pocall_stdcall } 3,
  640. { pocall_softfloat } 10,
  641. { pocall_mwpascal } 11,
  642. { pocall_interrupt } 12
  643. );
  644. procedure write_param_flag(parasym:tparavarsym);
  645. var
  646. paraspec : byte;
  647. begin
  648. case parasym.varspez of
  649. vs_value : paraspec := 0;
  650. vs_const : paraspec := pfConst;
  651. vs_var : paraspec := pfVar;
  652. vs_out : paraspec := pfOut;
  653. vs_constref: paraspec := pfConstRef;
  654. else
  655. internalerror(2013112904);
  656. end;
  657. { Kylix also seems to always add both pfArray and pfReference
  658. in this case
  659. }
  660. if is_open_array(parasym.vardef) then
  661. paraspec:=paraspec or pfArray or pfReference;
  662. { and these for classes and interfaces (maybe because they
  663. are themselves addresses?)
  664. }
  665. if is_class_or_interface(parasym.vardef) then
  666. paraspec:=paraspec or pfAddress;
  667. { set bits run from the highest to the lowest bit on
  668. big endian systems
  669. }
  670. if (target_info.endian = endian_big) then
  671. paraspec:=reverse_byte(paraspec);
  672. { write flags for current parameter }
  673. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
  674. end;
  675. procedure write_para(parasym:tparavarsym);
  676. begin
  677. { only store user visible parameters }
  678. if not(vo_is_hidden_para in parasym.varoptions) then
  679. begin
  680. { write flags for current parameter }
  681. write_param_flag(parasym);
  682. { write name of current parameter }
  683. write_string(parasym.realname);
  684. { write name of type of current parameter }
  685. write_rtti_name(parasym.vardef);
  686. end;
  687. end;
  688. procedure write_procedure_param(parasym:tparavarsym);
  689. begin
  690. { only store user visible parameters }
  691. if not(vo_is_hidden_para in parasym.varoptions) then
  692. begin
  693. { write flags for current parameter }
  694. write_param_flag(parasym);
  695. maybe_write_align;
  696. { write param type }
  697. write_rtti_reference(parasym.vardef,fullrtti);
  698. { write name of current parameter }
  699. write_string(parasym.realname);
  700. end;
  701. end;
  702. var
  703. methodkind : byte;
  704. i : integer;
  705. begin
  706. if po_methodpointer in def.procoptions then
  707. begin
  708. { write method id and name }
  709. write_header(def,tkMethod);
  710. maybe_write_align;
  711. { write kind of method }
  712. case def.proctypeoption of
  713. potype_constructor: methodkind:=mkConstructor;
  714. potype_destructor: methodkind:=mkDestructor;
  715. potype_class_constructor: methodkind:=mkClassConstructor;
  716. potype_class_destructor: methodkind:=mkClassDestructor;
  717. potype_operator: methodkind:=mkOperatorOverload;
  718. potype_procedure:
  719. if po_classmethod in def.procoptions then
  720. methodkind:=mkClassProcedure
  721. else
  722. methodkind:=mkProcedure;
  723. potype_function:
  724. if po_classmethod in def.procoptions then
  725. methodkind:=mkClassFunction
  726. else
  727. methodkind:=mkFunction;
  728. else
  729. begin
  730. if def.returndef = voidtype then
  731. methodkind:=mkProcedure
  732. else
  733. methodkind:=mkFunction;
  734. end;
  735. end;
  736. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
  737. { write parameter info. The parameters must be written in reverse order
  738. if this method uses right to left parameter pushing! }
  739. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
  740. for i:=0 to def.paras.count-1 do
  741. write_para(tparavarsym(def.paras[i]));
  742. if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
  743. begin
  744. { write name of result type }
  745. write_rtti_name(def.returndef);
  746. maybe_write_align;
  747. { write result typeinfo }
  748. write_rtti_reference(def.returndef,fullrtti);
  749. end;
  750. { write calling convention }
  751. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
  752. maybe_write_align;
  753. { write params typeinfo }
  754. for i:=0 to def.paras.count-1 do
  755. if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
  756. write_rtti_reference(tparavarsym(def.paras[i]).vardef,fullrtti);
  757. end
  758. else
  759. begin
  760. write_header(def,tkProcvar);
  761. maybe_write_align;
  762. { flags }
  763. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
  764. //maybe_write_align; // aligning between bytes is not necessary
  765. { write calling convention }
  766. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
  767. maybe_write_align;
  768. { write result typeinfo }
  769. write_rtti_reference(def.returndef,fullrtti);
  770. { write parameter count }
  771. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
  772. for i:=0 to def.paras.count-1 do
  773. begin
  774. maybe_write_align;
  775. write_procedure_param(tparavarsym(def.paras[i]));
  776. end;
  777. end;
  778. end;
  779. procedure objectdef_rtti(def:tobjectdef);
  780. procedure objectdef_rtti_fields(def:tobjectdef);
  781. var
  782. offsetsym : tfieldvarsym;
  783. begin
  784. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  785. fields_write_rtti_data(def,rt);
  786. if def.objecttype=odt_class then
  787. begin
  788. maybe_write_align;
  789. if oo_is_reference_counted in def.objectoptions then
  790. begin
  791. offsetsym:=tfieldvarsym(def.refcount_field);
  792. if not assigned(offsetsym) or (offsetsym.typ<>fieldvarsym) then
  793. internalerror(2014101203);
  794. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create(aitconst_ptr,offsetsym.fieldoffset));
  795. end
  796. else
  797. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create(aitconst_ptr,0));
  798. end;
  799. end;
  800. procedure objectdef_rtti_interface_init(def:tobjectdef);
  801. begin
  802. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  803. end;
  804. procedure objectdef_rtti_class_full(def:tobjectdef);
  805. var
  806. propnamelist : TFPHashObjectList;
  807. begin
  808. { Collect unique property names with nameindex }
  809. propnamelist:=TFPHashObjectList.Create;
  810. collect_propnamelist(propnamelist,def);
  811. if not is_objectpascal_helper(def) then
  812. if (oo_has_vmt in def.objectoptions) then
  813. current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,AT_DATA,0))
  814. else
  815. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_dataptr);
  816. { write parent typeinfo }
  817. write_rtti_reference(def.childof,fullrtti);
  818. { write typeinfo of extended type }
  819. if is_objectpascal_helper(def) then
  820. if assigned(def.extendeddef) then
  821. write_rtti_reference(def.extendeddef,fullrtti)
  822. else
  823. InternalError(2011033001);
  824. { total number of unique properties }
  825. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
  826. { write unit name }
  827. write_string(current_module.realmodulename^);
  828. maybe_write_align;
  829. { write published properties for this object }
  830. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
  831. maybe_write_align;
  832. published_properties_write_rtti_data(propnamelist,def.symtable);
  833. propnamelist.free;
  834. end;
  835. procedure objectdef_rtti_interface_full(def:tobjectdef);
  836. var
  837. i : longint;
  838. propnamelist : TFPHashObjectList;
  839. { if changed to a set, make sure it's still a byte large, and
  840. swap appropriately when cross-compiling
  841. }
  842. IntfFlags: byte;
  843. begin
  844. { Collect unique property names with nameindex }
  845. propnamelist:=TFPHashObjectList.Create;
  846. collect_propnamelist(propnamelist,def);
  847. { write parent typeinfo }
  848. write_rtti_reference(def.childof,fullrtti);
  849. { interface: write flags, iid and iidstr }
  850. IntfFlags:=0;
  851. if assigned(def.iidguid) then
  852. IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid));
  853. if assigned(def.iidstr) then
  854. IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID));
  855. if (def.objecttype=odt_dispinterface) then
  856. IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface));
  857. if (target_info.endian=endian_big) then
  858. IntfFlags:=reverse_byte(IntfFlags);
  859. {
  860. ifDispatch, }
  861. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags));
  862. maybe_write_align;
  863. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
  864. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2));
  865. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3));
  866. for i:=Low(def.iidguid^.D4) to High(def.iidguid^.D4) do
  867. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.iidguid^.D4[i]));
  868. { write unit name }
  869. write_string(current_module.realmodulename^);
  870. maybe_write_align;
  871. { write iidstr }
  872. if assigned(def.iidstr) then
  873. write_string(def.iidstr^)
  874. else
  875. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
  876. maybe_write_align;
  877. { write published properties for this object }
  878. published_properties_write_rtti_data(propnamelist,def.symtable);
  879. propnamelist.free;
  880. end;
  881. begin
  882. case def.objecttype of
  883. odt_class:
  884. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
  885. odt_object:
  886. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject));
  887. odt_dispinterface,
  888. odt_interfacecom:
  889. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
  890. odt_interfacecorba:
  891. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
  892. odt_helper:
  893. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkhelper));
  894. else
  895. internalerror(200611034);
  896. end;
  897. { generate the name }
  898. write_string(def.objrealname^);
  899. maybe_write_align;
  900. case rt of
  901. initrtti :
  902. begin
  903. if def.objecttype in [odt_class,odt_object,odt_helper] then
  904. objectdef_rtti_fields(def)
  905. else
  906. objectdef_rtti_interface_init(def);
  907. end;
  908. fullrtti :
  909. begin
  910. case def.objecttype of
  911. odt_helper,
  912. odt_class:
  913. objectdef_rtti_class_full(def);
  914. odt_object:
  915. objectdef_rtti_fields(def);
  916. else
  917. objectdef_rtti_interface_full(def);
  918. end;
  919. end;
  920. end;
  921. end;
  922. begin
  923. case def.typ of
  924. variantdef :
  925. variantdef_rtti(tvariantdef(def));
  926. stringdef :
  927. stringdef_rtti(tstringdef(def));
  928. enumdef :
  929. enumdef_rtti(tenumdef(def));
  930. orddef :
  931. orddef_rtti(torddef(def));
  932. floatdef :
  933. floatdef_rtti(tfloatdef(def));
  934. setdef :
  935. setdef_rtti(tsetdef(def));
  936. procvardef :
  937. procvardef_rtti(tprocvardef(def));
  938. arraydef :
  939. begin
  940. if ado_IsBitPacked in tarraydef(def).arrayoptions then
  941. unknown_rtti(tstoreddef(def))
  942. else
  943. arraydef_rtti(tarraydef(def));
  944. end;
  945. recorddef :
  946. begin
  947. if trecorddef(def).is_packed then
  948. unknown_rtti(tstoreddef(def))
  949. else
  950. recorddef_rtti(trecorddef(def));
  951. end;
  952. objectdef :
  953. objectdef_rtti(tobjectdef(def));
  954. classrefdef :
  955. classrefdef_rtti(tclassrefdef(def));
  956. pointerdef :
  957. pointerdef_rtti(tpointerdef(def));
  958. else
  959. unknown_rtti(tstoreddef(def));
  960. end;
  961. end;
  962. procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
  963. type Penumsym = ^Tenumsym;
  964. function enumdef_rtti_calcstringtablestart(const def : Tenumdef) : integer;
  965. begin
  966. { the alignment calls must correspond to the ones used during generating the
  967. actual data structure created elsewhere in this file }
  968. result:=1;
  969. if assigned(def.typesym) then
  970. inc(result,length(def.typesym.realname)+1)
  971. else
  972. inc(result);
  973. if (tf_requires_proper_alignment in target_info.flags) then
  974. result:=align(result,sizeof(Tconstptruint));
  975. inc(result);
  976. if (tf_requires_proper_alignment in target_info.flags) then
  977. result:=align(result,sizeof(Tconstptruint));
  978. inc(result, sizeof(longint) * 2);
  979. if (tf_requires_proper_alignment in target_info.flags) then
  980. result:=align(result,sizeof(Tconstptruint));
  981. inc(result, sizeof(pint));
  982. end;
  983. { Writes a helper table for accelerated conversion of ordinal enum values to strings.
  984. If you change something in this method, make sure to adapt the corresponding code
  985. in sstrings.inc. }
  986. procedure enumdef_rtti_ord2stringindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint);
  987. var rttilab:Tasmsymbol;
  988. h,i,o,prev_value:longint;
  989. mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
  990. r:single; {Must be real type because of integer overflow risk.}
  991. begin
  992. {Decide wether a lookup array is size efficient.}
  993. mode:=lookup;
  994. if sym_count>0 then
  995. begin
  996. i:=1;
  997. r:=0;
  998. h:=syms[0].value; {Next expected enum value is min.}
  999. { set prev_value for the first iteration to a value that is
  1000. different from the first one without risking overflow (it's used
  1001. to detect whether two enum values are the same) }
  1002. if h=0 then
  1003. prev_value:=1
  1004. else
  1005. prev_value:=0;
  1006. while i<sym_count do
  1007. begin
  1008. { if two enum values are the same, we have to create a table }
  1009. if (prev_value=h) then
  1010. begin
  1011. mode:=search;
  1012. break;
  1013. end;
  1014. {Calculate size of hole between values. Avoid integer overflows.}
  1015. r:=r+(single(syms[i].value)-single(h))-1;
  1016. prev_value:=h;
  1017. h:=syms[i].value;
  1018. inc(i);
  1019. end;
  1020. if r>sym_count then
  1021. mode:=search; {Don't waste more than 50% space.}
  1022. end;
  1023. { write rtti data; make sure that the alignment matches the corresponding data structure
  1024. in the code that uses it (if alignment is required). }
  1025. with current_asmdata do
  1026. begin
  1027. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
  1028. maybe_new_object_file(asmlists[al_rtti]);
  1029. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1030. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  1031. asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
  1032. if mode=lookup then
  1033. begin
  1034. maybe_write_align;
  1035. o:=syms[0].value; {Start with min value.}
  1036. for i:=0 to sym_count-1 do
  1037. begin
  1038. while o<syms[i].value do
  1039. begin
  1040. asmlists[al_rtti].concat(Tai_const.create_pint(0));
  1041. inc(o);
  1042. end;
  1043. inc(o);
  1044. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  1045. end;
  1046. end
  1047. else
  1048. begin
  1049. maybe_write_align;
  1050. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  1051. for i:=0 to sym_count-1 do
  1052. begin
  1053. maybe_write_align;
  1054. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  1055. maybe_write_align;
  1056. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  1057. end;
  1058. end;
  1059. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  1060. end;
  1061. end;
  1062. { Writes a helper table for accelerated conversion of string to ordinal enum values.
  1063. If you change something in this method, make sure to adapt the corresponding code
  1064. in sstrings.inc. }
  1065. procedure enumdef_rtti_string2ordindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint);
  1066. var rttilab:Tasmsymbol;
  1067. i:longint;
  1068. begin
  1069. { write rtti data }
  1070. with current_asmdata do
  1071. begin
  1072. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
  1073. maybe_new_object_file(asmlists[al_rtti]);
  1074. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1075. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  1076. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  1077. { need to align the entry record according to the largest member }
  1078. maybe_write_align;
  1079. for i:=0 to sym_count-1 do
  1080. begin
  1081. if (tf_requires_proper_alignment in target_info.flags) then
  1082. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4)); // necessary?
  1083. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  1084. maybe_write_align;
  1085. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  1086. end;
  1087. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  1088. end;
  1089. end;
  1090. procedure enumdef_rtti_extrasyms(def:Tenumdef);
  1091. var
  1092. t:Tenumsym;
  1093. syms:Penumsym;
  1094. sym_count,sym_alloc:sizeuint;
  1095. offsets:^longint;
  1096. h,i,p,o,st:longint;
  1097. begin
  1098. {Random access needed, put in array.}
  1099. getmem(syms,64*sizeof(Tenumsym));
  1100. getmem(offsets,64*sizeof(longint));
  1101. sym_count:=0;
  1102. sym_alloc:=64;
  1103. st:=0;
  1104. for i := 0 to def.symtable.SymList.Count - 1 do
  1105. begin
  1106. t:=tenumsym(def.symtable.SymList[i]);
  1107. if t.value<def.minval then
  1108. continue
  1109. else
  1110. if t.value>def.maxval then
  1111. break;
  1112. if sym_count>=sym_alloc then
  1113. begin
  1114. reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
  1115. reallocmem(offsets,2*sym_alloc*sizeof(longint));
  1116. sym_alloc:=sym_alloc*2;
  1117. end;
  1118. syms[sym_count]:=t;
  1119. offsets[sym_count]:=st;
  1120. inc(sym_count);
  1121. st:=st+length(t.realname)+1;
  1122. end;
  1123. {Sort the syms by enum name}
  1124. if sym_count>=2 then
  1125. begin
  1126. p:=1;
  1127. while 2*p<sym_count do
  1128. p:=2*p;
  1129. while p<>0 do
  1130. begin
  1131. for h:=p to sym_count-1 do
  1132. begin
  1133. i:=h;
  1134. t:=syms[i];
  1135. o:=offsets[i];
  1136. repeat
  1137. if syms[i-p].name<=t.name then
  1138. break;
  1139. syms[i]:=syms[i-p];
  1140. offsets[i]:=offsets[i-p];
  1141. dec(i,p);
  1142. until i<p;
  1143. syms[i]:=t;
  1144. offsets[i]:=o;
  1145. end;
  1146. p:=p shr 1;
  1147. end;
  1148. end;
  1149. st:=enumdef_rtti_calcstringtablestart(def);
  1150. enumdef_rtti_string2ordindex(sym_count,offsets,syms,st);
  1151. { Sort the syms by enum value }
  1152. if sym_count>=2 then
  1153. begin
  1154. p:=1;
  1155. while 2*p<sym_count do
  1156. p:=2*p;
  1157. while p<>0 do
  1158. begin
  1159. for h:=p to sym_count-1 do
  1160. begin
  1161. i:=h;
  1162. t:=syms[i];
  1163. o:=offsets[i];
  1164. repeat
  1165. if syms[i-p].value<=t.value then
  1166. break;
  1167. syms[i]:=syms[i-p];
  1168. offsets[i]:=offsets[i-p];
  1169. dec(i,p);
  1170. until i<p;
  1171. syms[i]:=t;
  1172. offsets[i]:=o;
  1173. end;
  1174. p:=p shr 1;
  1175. end;
  1176. end;
  1177. enumdef_rtti_ord2stringindex(sym_count,offsets,syms,st);
  1178. freemem(syms);
  1179. freemem(offsets);
  1180. end;
  1181. begin
  1182. case def.typ of
  1183. enumdef:
  1184. if rt=fullrtti then
  1185. begin
  1186. enumdef_rtti_extrasyms(Tenumdef(def));
  1187. end;
  1188. end;
  1189. end;
  1190. procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
  1191. begin
  1192. case def.typ of
  1193. enumdef :
  1194. if assigned(tenumdef(def).basedef) then
  1195. write_rtti(tenumdef(def).basedef,rt);
  1196. setdef :
  1197. write_rtti(tsetdef(def).elementdef,rt);
  1198. arraydef :
  1199. begin
  1200. write_rtti(tarraydef(def).rangedef,rt);
  1201. write_rtti(tarraydef(def).elementdef,rt);
  1202. end;
  1203. recorddef :
  1204. fields_write_rtti(trecorddef(def).symtable,rt);
  1205. objectdef :
  1206. begin
  1207. if assigned(tobjectdef(def).childof) then
  1208. write_rtti(tobjectdef(def).childof,rt);
  1209. if (rt=initrtti) or (tobjectdef(def).objecttype=odt_object) then
  1210. fields_write_rtti(tobjectdef(def).symtable,rt)
  1211. else
  1212. published_write_rtti(tobjectdef(def).symtable,rt);
  1213. end;
  1214. classrefdef,
  1215. pointerdef:
  1216. if not is_objc_class_or_protocol(tabstractpointerdef(def).pointeddef) then
  1217. write_rtti(tabstractpointerdef(def).pointeddef,rt);
  1218. procvardef:
  1219. params_write_rtti(tabstractprocdef(def),rt);
  1220. end;
  1221. end;
  1222. procedure TRTTIWriter.write_rtti_reference(def:tdef;rt:trttitype);
  1223. begin
  1224. if not assigned(def) or is_void(def) or ((rt<>initrtti) and is_objc_class_or_protocol(def)) then
  1225. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_dataptr)
  1226. else
  1227. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def,rt)));
  1228. end;
  1229. function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
  1230. begin
  1231. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt),AT_DATA);
  1232. if (cs_create_pic in current_settings.moduleswitches) and
  1233. assigned(current_procinfo) then
  1234. include(current_procinfo.flags,pi_needs_got);
  1235. end;
  1236. procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
  1237. var
  1238. rttilab : tasmsymbol;
  1239. begin
  1240. { only write rtti of definitions from the current module }
  1241. if not findunitsymtable(def.owner).iscurrentunit then
  1242. exit;
  1243. { check if separate initrtti is actually needed }
  1244. if (rt=initrtti) and (not def.needs_separate_initrtti) then
  1245. rt:=fullrtti;
  1246. { prevent recursion }
  1247. if rttidefstate[rt] in def.defstates then
  1248. exit;
  1249. include(def.defstates,rttidefstate[rt]);
  1250. { write first all dependencies }
  1251. write_child_rtti_data(def,rt);
  1252. { write rtti data }
  1253. rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
  1254. maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
  1255. new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1256. current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
  1257. write_rtti_data(def,rt);
  1258. current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
  1259. write_rtti_extrasyms(def,rt,rttilab);
  1260. end;
  1261. function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
  1262. begin
  1263. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt),AT_DATA);
  1264. if (cs_create_pic in current_settings.moduleswitches) and
  1265. assigned(current_procinfo) then
  1266. include(current_procinfo.flags,pi_needs_got);
  1267. end;
  1268. function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
  1269. begin
  1270. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s',AT_DATA);
  1271. if (cs_create_pic in current_settings.moduleswitches) and
  1272. assigned(current_procinfo) then
  1273. include(current_procinfo.flags,pi_needs_got);
  1274. end;
  1275. function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
  1276. begin
  1277. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o',AT_DATA);
  1278. if (cs_create_pic in current_settings.moduleswitches) and
  1279. assigned(current_procinfo) then
  1280. include(current_procinfo.flags,pi_needs_got);
  1281. end;
  1282. end.