ncgrtti.pas 53 KB

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