ncgrtti.pas 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276
  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. tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
  286. { register for wpo }
  287. tprocdef(propaccesslist.procdef)._class.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. if (tf_requires_proper_alignment in target_info.flags) then
  395. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(longint(def.size)));
  396. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min));
  397. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max));
  398. if (tf_requires_proper_alignment in target_info.flags) then
  399. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
  400. { write base type }
  401. if assigned(def.basedef) then
  402. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.basedef,rt)))
  403. else
  404. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  405. for i := 0 to def.symtable.SymList.Count - 1 do
  406. begin
  407. hp:=tenumsym(def.symtable.SymList[i]);
  408. if hp.value<def.minval then
  409. continue
  410. else
  411. if hp.value>def.maxval then
  412. break;
  413. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname)));
  414. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(hp.realname));
  415. end;
  416. { write unit name }
  417. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  418. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  419. end;
  420. procedure orddef_rtti(def:torddef);
  421. procedure dointeger;
  422. const
  423. trans : array[tordtype] of byte =
  424. (otUByte{otNone},
  425. otUByte,otUWord,otULong,otUByte{otNone},
  426. otSByte,otSWord,otSLong,otUByte{otNone},
  427. otUByte,otSByte,otSWord,otSLong,otSByte,
  428. otUByte,otUWord,otUByte);
  429. begin
  430. write_rtti_name(def);
  431. if (tf_requires_proper_alignment in target_info.flags) then
  432. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  433. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype])));
  434. if (tf_requires_proper_alignment in target_info.flags) then
  435. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  436. {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
  437. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low.svalue)));
  438. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high.svalue)));
  439. end;
  440. begin
  441. case def.ordtype of
  442. s64bit :
  443. begin
  444. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInt64));
  445. write_rtti_name(def);
  446. if (tf_requires_proper_alignment in target_info.flags) then
  447. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  448. { low }
  449. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
  450. { high }
  451. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
  452. end;
  453. u64bit :
  454. begin
  455. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkQWord));
  456. write_rtti_name(def);
  457. if (tf_requires_proper_alignment in target_info.flags) then
  458. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  459. {use svalue because Create_64bit accepts int64, prevents range checks}
  460. { low }
  461. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue));
  462. { high }
  463. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
  464. end;
  465. pasbool:
  466. begin
  467. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkBool));
  468. dointeger;
  469. end;
  470. uchar:
  471. begin
  472. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkChar));
  473. dointeger;
  474. end;
  475. uwidechar:
  476. begin
  477. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWChar));
  478. dointeger;
  479. end;
  480. scurrency:
  481. begin
  482. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
  483. write_rtti_name(def);
  484. if (tf_requires_proper_alignment in target_info.flags) then
  485. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  486. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ftCurr));
  487. end;
  488. else
  489. begin
  490. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInteger));
  491. dointeger;
  492. end;
  493. end;
  494. end;
  495. procedure floatdef_rtti(def:tfloatdef);
  496. const
  497. {tfloattype = (s32real,s64real,s80real,sc80real,s64bit,s128bit);}
  498. translate : array[tfloattype] of byte =
  499. (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
  500. begin
  501. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
  502. write_rtti_name(def);
  503. if (tf_requires_proper_alignment in target_info.flags) then
  504. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  505. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[def.floattype]));
  506. end;
  507. procedure setdef_rtti(def:tsetdef);
  508. begin
  509. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSet));
  510. write_rtti_name(def);
  511. if (tf_requires_proper_alignment in target_info.flags) then
  512. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  513. case def.size of
  514. 1:
  515. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
  516. 2:
  517. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
  518. 4:
  519. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
  520. else
  521. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
  522. end;
  523. if (tf_requires_proper_alignment in target_info.flags) then
  524. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  525. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
  526. end;
  527. procedure arraydef_rtti(def:tarraydef);
  528. begin
  529. if ado_IsDynamicArray in def.arrayoptions then
  530. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
  531. else
  532. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
  533. write_rtti_name(def);
  534. if (tf_requires_proper_alignment in target_info.flags) then
  535. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  536. { size of elements }
  537. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize));
  538. if not(ado_IsDynamicArray in def.arrayoptions) then
  539. begin
  540. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(pint(def.elecount)));
  541. { element type }
  542. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
  543. end
  544. else
  545. { write a delphi almost compatible dyn. array entry:
  546. there are two types, eltype and eltype2, the latter is nil if the element type needs
  547. no finalization, the former is always valid, delphi has this swapped, but for
  548. compatibility with older fpc versions we do it different, to be delphi compatible,
  549. the names are swapped in typinfo.pp
  550. }
  551. begin
  552. { element type }
  553. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
  554. end;
  555. { variant type }
  556. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
  557. if ado_IsDynamicArray in def.arrayoptions then
  558. begin
  559. { element type }
  560. if def.elementdef.needs_inittable then
  561. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)))
  562. else
  563. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(0));
  564. { write unit name }
  565. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  566. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  567. end;
  568. end;
  569. procedure recorddef_rtti(def:trecorddef);
  570. var
  571. fieldcnt : longint;
  572. begin
  573. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkrecord));
  574. write_rtti_name(def);
  575. if (tf_requires_proper_alignment in target_info.flags) then
  576. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  577. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  578. fieldcnt:=fields_count(def.symtable,rt);
  579. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fieldcnt));
  580. fields_write_rtti_data(def.symtable,rt);
  581. end;
  582. procedure procvardef_rtti(def:tprocvardef);
  583. const
  584. ProcCallOptionToCallConv: array[tproccalloption] of byte = (
  585. { pocall_none } 0,
  586. { pocall_cdecl } 1,
  587. { pocall_cppdecl } 5,
  588. { pocall_far16 } 6,
  589. { pocall_oldfpccall } 7,
  590. { pocall_internproc } 8,
  591. { pocall_syscall } 9,
  592. { pocall_pascal } 2,
  593. { pocall_register } 0,
  594. { pocall_safecall } 4,
  595. { pocall_stdcall } 3,
  596. { pocall_softfloat } 10,
  597. { pocall_mwpascal } 11
  598. );
  599. procedure write_para(parasym:tparavarsym);
  600. var
  601. paraspec : byte;
  602. begin
  603. { only store user visible parameters }
  604. if not(vo_is_hidden_para in parasym.varoptions) then
  605. begin
  606. case parasym.varspez of
  607. vs_value: paraspec := 0;
  608. vs_const: paraspec := pfConst;
  609. vs_var : paraspec := pfVar;
  610. vs_out : paraspec := pfOut;
  611. end;
  612. { Kylix also seems to always add both pfArray and pfReference
  613. in this case
  614. }
  615. if is_open_array(parasym.vardef) then
  616. paraspec:=paraspec or pfArray or pfReference;
  617. { and these for classes and interfaces (maybe because they
  618. are themselves addresses?)
  619. }
  620. if is_class_or_interface(parasym.vardef) then
  621. paraspec:=paraspec or pfAddress;
  622. { set bits run from the highest to the lowest bit on
  623. big endian systems
  624. }
  625. if (target_info.endian = endian_big) then
  626. paraspec:=reverse_byte(paraspec);
  627. { write flags for current parameter }
  628. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
  629. { write name of current parameter }
  630. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(parasym.realname)));
  631. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(parasym.realname));
  632. { write name of type of current parameter }
  633. write_rtti_name(parasym.vardef);
  634. end;
  635. end;
  636. var
  637. methodkind : byte;
  638. i : integer;
  639. begin
  640. if po_methodpointer in def.procoptions then
  641. begin
  642. { write method id and name }
  643. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkmethod));
  644. write_rtti_name(def);
  645. if (tf_requires_proper_alignment in target_info.flags) then
  646. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  647. { write kind of method }
  648. case def.proctypeoption of
  649. potype_constructor: methodkind:=mkConstructor;
  650. potype_destructor: methodkind:=mkDestructor;
  651. potype_class_constructor: methodkind:=mkClassConstructor;
  652. potype_class_destructor: methodkind:=mkClassDestructor;
  653. potype_procedure:
  654. if po_classmethod in def.procoptions then
  655. methodkind:=mkClassProcedure
  656. else
  657. methodkind:=mkProcedure;
  658. potype_function:
  659. if po_classmethod in def.procoptions then
  660. methodkind:=mkClassFunction
  661. else
  662. methodkind:=mkFunction;
  663. else
  664. begin
  665. if def.returndef = voidtype then
  666. methodkind:=mkProcedure
  667. else
  668. methodkind:=mkFunction;
  669. end;
  670. end;
  671. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
  672. { write parameter info. The parameters must be written in reverse order
  673. if this method uses right to left parameter pushing! }
  674. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
  675. for i:=0 to def.paras.count-1 do
  676. write_para(tparavarsym(def.paras[i]));
  677. if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
  678. begin
  679. { write name of result type }
  680. write_rtti_name(def.returndef);
  681. if (tf_requires_proper_alignment in target_info.flags) then
  682. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
  683. { write result typeinfo }
  684. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti)))
  685. end;
  686. { write calling convention }
  687. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
  688. if (tf_requires_proper_alignment in target_info.flags) then
  689. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
  690. { write params typeinfo }
  691. for i:=0 to def.paras.count-1 do
  692. if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
  693. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti)));
  694. end
  695. else
  696. begin
  697. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkprocvar));
  698. write_rtti_name(def);
  699. end;
  700. end;
  701. procedure objectdef_rtti(def:tobjectdef);
  702. procedure objectdef_rtti_class_init(def:tobjectdef);
  703. begin
  704. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  705. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fields_count(def.symtable,rt)));
  706. fields_write_rtti_data(def.symtable,rt);
  707. end;
  708. procedure objectdef_rtti_interface_init(def:tobjectdef);
  709. begin
  710. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  711. end;
  712. procedure objectdef_rtti_class_full(def:tobjectdef);
  713. var
  714. propnamelist : TFPHashObjectList;
  715. begin
  716. { Collect unique property names with nameindex }
  717. propnamelist:=TFPHashObjectList.Create;
  718. collect_propnamelist(propnamelist,def);
  719. if (oo_has_vmt in def.objectoptions) then
  720. current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
  721. else
  722. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  723. { write parent typeinfo }
  724. if assigned(def.childof) then
  725. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
  726. else
  727. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  728. { total number of unique properties }
  729. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
  730. { write unit name }
  731. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  732. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  733. if (tf_requires_proper_alignment in target_info.flags) then
  734. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  735. { write published properties for this object }
  736. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
  737. if (tf_requires_proper_alignment in target_info.flags) then
  738. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  739. published_properties_write_rtti_data(propnamelist,def.symtable);
  740. propnamelist.free;
  741. end;
  742. procedure objectdef_rtti_interface_full(def:tobjectdef);
  743. var
  744. i : longint;
  745. propnamelist : TFPHashObjectList;
  746. { if changed to a set, make sure it's still a byte large, and
  747. swap appropriately when cross-compiling
  748. }
  749. IntfFlags: byte;
  750. begin
  751. { Collect unique property names with nameindex }
  752. propnamelist:=TFPHashObjectList.Create;
  753. collect_propnamelist(propnamelist,def);
  754. { write parent typeinfo }
  755. if assigned(def.childof) then
  756. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
  757. else
  758. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  759. { interface: write flags, iid and iidstr }
  760. IntfFlags:=0;
  761. if assigned(def.iidguid) then
  762. IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid));
  763. if assigned(def.iidstr) then
  764. IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID));
  765. if (def.objecttype=odt_dispinterface) then
  766. IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface));
  767. if (target_info.endian=endian_big) then
  768. IntfFlags:=reverse_byte(IntfFlags);
  769. {
  770. ifDispatch, }
  771. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags));
  772. if (tf_requires_proper_alignment in target_info.flags) then
  773. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  774. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
  775. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2));
  776. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3));
  777. for i:=Low(def.iidguid^.D4) to High(def.iidguid^.D4) do
  778. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.iidguid^.D4[i]));
  779. { write unit name }
  780. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  781. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  782. if (tf_requires_proper_alignment in target_info.flags) then
  783. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  784. { write iidstr }
  785. if assigned(def.iidstr) then
  786. begin
  787. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.iidstr^)));
  788. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.iidstr^));
  789. end
  790. else
  791. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
  792. if (tf_requires_proper_alignment in target_info.flags) then
  793. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  794. { write published properties for this object }
  795. published_properties_write_rtti_data(propnamelist,def.symtable);
  796. propnamelist.free;
  797. end;
  798. begin
  799. case def.objecttype of
  800. odt_class:
  801. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
  802. odt_object:
  803. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject));
  804. odt_dispinterface,
  805. odt_interfacecom:
  806. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
  807. odt_interfacecorba:
  808. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
  809. else
  810. internalerror(200611034);
  811. end;
  812. { generate the name }
  813. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.objrealname^)));
  814. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.objrealname^));
  815. if (tf_requires_proper_alignment in target_info.flags) then
  816. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  817. case rt of
  818. initrtti :
  819. begin
  820. if def.objecttype in [odt_class,odt_object] then
  821. objectdef_rtti_class_init(def)
  822. else
  823. objectdef_rtti_interface_init(def);
  824. end;
  825. fullrtti :
  826. begin
  827. if def.objecttype in [odt_class,odt_object] then
  828. objectdef_rtti_class_full(def)
  829. else
  830. objectdef_rtti_interface_full(def);
  831. end;
  832. end;
  833. end;
  834. begin
  835. case def.typ of
  836. variantdef :
  837. variantdef_rtti(tvariantdef(def));
  838. stringdef :
  839. stringdef_rtti(tstringdef(def));
  840. enumdef :
  841. enumdef_rtti(tenumdef(def));
  842. orddef :
  843. orddef_rtti(torddef(def));
  844. floatdef :
  845. floatdef_rtti(tfloatdef(def));
  846. setdef :
  847. setdef_rtti(tsetdef(def));
  848. procvardef :
  849. procvardef_rtti(tprocvardef(def));
  850. arraydef :
  851. begin
  852. if ado_IsBitPacked in tarraydef(def).arrayoptions then
  853. unknown_rtti(tstoreddef(def))
  854. else
  855. arraydef_rtti(tarraydef(def));
  856. end;
  857. recorddef :
  858. begin
  859. if trecorddef(def).is_packed then
  860. unknown_rtti(tstoreddef(def))
  861. else
  862. recorddef_rtti(trecorddef(def));
  863. end;
  864. objectdef :
  865. objectdef_rtti(tobjectdef(def));
  866. else
  867. unknown_rtti(tstoreddef(def));
  868. end;
  869. end;
  870. procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
  871. procedure enumdef_rtti_ord2stringindex(def:Tenumdef);
  872. var rttilab:Tasmsymbol;
  873. t:Tenumsym;
  874. syms:^Tenumsym;
  875. offsets:^longint;
  876. sym_count,sym_alloc:longint;
  877. h,i,p,o,st:longint;
  878. mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
  879. r:single; {Must be real type because of integer overflow risk.}
  880. begin
  881. {Random access needed, put in array.}
  882. getmem(syms,64*sizeof(Tenumsym));
  883. getmem(offsets,64*sizeof(longint));
  884. sym_count:=0;
  885. sym_alloc:=64;
  886. st:=0;
  887. for i := 0 to def.symtable.SymList.Count - 1 do
  888. begin
  889. t:=tenumsym(def.symtable.SymList[i]);
  890. if t.value<def.minval then
  891. continue
  892. else
  893. if t.value>def.maxval then
  894. break;
  895. if sym_count>=sym_alloc then
  896. begin
  897. reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
  898. reallocmem(offsets,2*sym_alloc*sizeof(longint));
  899. sym_alloc:=sym_alloc*2;
  900. end;
  901. syms[sym_count]:=t;
  902. offsets[sym_count]:=st;
  903. inc(sym_count);
  904. st:=st+length(t.realname)+1;
  905. end;
  906. {Sort the syms by enum value}
  907. if sym_count>=2 then
  908. begin
  909. p:=1;
  910. while 2*p<sym_count do
  911. p:=2*p;
  912. while p<>0 do
  913. begin
  914. for h:=p to sym_count-1 do
  915. begin
  916. i:=h;
  917. t:=syms[i];
  918. o:=offsets[i];
  919. repeat
  920. if syms[i-p].value<=t.value then
  921. break;
  922. syms[i]:=syms[i-p];
  923. offsets[i]:=offsets[i-p];
  924. dec(i,p);
  925. until i<p;
  926. syms[i]:=t;
  927. offsets[i]:=o;
  928. end;
  929. p:=p shr 1;
  930. end;
  931. end;
  932. {Decide wether a lookup array is size efficient.}
  933. mode:=lookup;
  934. if sym_count>0 then
  935. begin
  936. i:=1;
  937. r:=0;
  938. h:=syms[0].value; {Next expected enum value is min.}
  939. while i<sym_count do
  940. begin
  941. {Calculate size of hole between values. Avoid integer overflows.}
  942. r:=r+(single(syms[i].value)-single(h))-1;
  943. h:=syms[i].value;
  944. inc(i);
  945. end;
  946. if r>sym_count then
  947. mode:=search; {Don't waste more than 50% space.}
  948. end;
  949. {Calculate start of string table.}
  950. st:=1;
  951. if assigned(def.typesym) then
  952. inc(st,length(def.typesym.realname)+1)
  953. else
  954. inc(st);
  955. if (tf_requires_proper_alignment in target_info.flags) then
  956. st:=align(st,sizeof(Tconstptruint));
  957. inc(st);
  958. if (tf_requires_proper_alignment in target_info.flags) then
  959. st:=align(st,sizeof(Tconstptruint));
  960. inc(st,8+sizeof(pint));
  961. { write rtti data }
  962. with current_asmdata do
  963. begin
  964. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
  965. maybe_new_object_file(asmlists[al_rtti]);
  966. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  967. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  968. asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
  969. if mode=lookup then
  970. begin
  971. if (tf_requires_proper_alignment in target_info.flags) then
  972. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  973. o:=syms[0].value; {Start with min value.}
  974. for i:=0 to sym_count-1 do
  975. begin
  976. while o<syms[i].value do
  977. begin
  978. asmlists[al_rtti].concat(Tai_const.create_pint(0));
  979. inc(o);
  980. end;
  981. inc(o);
  982. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  983. end;
  984. end
  985. else
  986. begin
  987. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  988. for i:=0 to sym_count-1 do
  989. begin
  990. if (tf_requires_proper_alignment in target_info.flags) then
  991. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
  992. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  993. if (tf_requires_proper_alignment in target_info.flags) then
  994. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  995. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  996. end;
  997. end;
  998. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  999. end;
  1000. freemem(syms);
  1001. freemem(offsets);
  1002. end;
  1003. procedure enumdef_rtti_string2ordindex(def:Tenumdef);
  1004. var rttilab:Tasmsymbol;
  1005. t:Tenumsym;
  1006. syms:^Tenumsym;
  1007. offsets:^longint;
  1008. sym_count,sym_alloc:longint;
  1009. h,i,p,o,st:longint;
  1010. begin
  1011. {Random access needed, put in array.}
  1012. getmem(syms,64*sizeof(Tenumsym));
  1013. getmem(offsets,64*sizeof(longint));
  1014. sym_count:=0;
  1015. sym_alloc:=64;
  1016. st:=0;
  1017. for i := 0 to def.symtable.SymList.Count - 1 do
  1018. begin
  1019. t:=tenumsym(def.symtable.SymList[i]);
  1020. if t.value<def.minval then
  1021. continue
  1022. else
  1023. if t.value>def.maxval then
  1024. break;
  1025. if sym_count>=sym_alloc then
  1026. begin
  1027. reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
  1028. reallocmem(offsets,2*sym_alloc*sizeof(longint));
  1029. sym_alloc:=sym_alloc*2;
  1030. end;
  1031. syms[sym_count]:=t;
  1032. offsets[sym_count]:=st;
  1033. inc(sym_count);
  1034. st:=st+length(t.realname)+1;
  1035. end;
  1036. {Sort the syms by enum name}
  1037. if sym_count>=2 then
  1038. begin
  1039. p:=1;
  1040. while 2*p<sym_count do
  1041. p:=2*p;
  1042. while p<>0 do
  1043. begin
  1044. for h:=p to sym_count-1 do
  1045. begin
  1046. i:=h;
  1047. t:=syms[i];
  1048. o:=offsets[i];
  1049. repeat
  1050. if syms[i-p].name<=t.name then
  1051. break;
  1052. syms[i]:=syms[i-p];
  1053. offsets[i]:=offsets[i-p];
  1054. dec(i,p);
  1055. until i<p;
  1056. syms[i]:=t;
  1057. offsets[i]:=o;
  1058. end;
  1059. p:=p shr 1;
  1060. end;
  1061. end;
  1062. {Calculate start of string table.}
  1063. st:=1;
  1064. if assigned(def.typesym) then
  1065. inc(st,length(def.typesym.realname)+1)
  1066. else
  1067. inc(st);
  1068. if (tf_requires_proper_alignment in target_info.flags) then
  1069. st:=align(st,sizeof(Tconstptruint));
  1070. inc(st);
  1071. if (tf_requires_proper_alignment in target_info.flags) then
  1072. st:=align(st,sizeof(Tconstptruint));
  1073. inc(st,8+sizeof(pint));
  1074. { write rtti data }
  1075. with current_asmdata do
  1076. begin
  1077. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
  1078. maybe_new_object_file(asmlists[al_rtti]);
  1079. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1080. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  1081. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  1082. for i:=0 to sym_count-1 do
  1083. begin
  1084. if (tf_requires_proper_alignment in target_info.flags) then
  1085. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
  1086. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  1087. if (tf_requires_proper_alignment in target_info.flags) then
  1088. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  1089. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  1090. end;
  1091. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  1092. end;
  1093. freemem(syms);
  1094. freemem(offsets);
  1095. end;
  1096. begin
  1097. case def.typ of
  1098. enumdef:
  1099. if rt=fullrtti then
  1100. begin
  1101. enumdef_rtti_ord2stringindex(Tenumdef(def));
  1102. enumdef_rtti_string2ordindex(Tenumdef(def));
  1103. end;
  1104. end;
  1105. end;
  1106. procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
  1107. begin
  1108. case def.typ of
  1109. enumdef :
  1110. if assigned(tenumdef(def).basedef) then
  1111. write_rtti(tenumdef(def).basedef,rt);
  1112. setdef :
  1113. write_rtti(tsetdef(def).elementdef,rt);
  1114. arraydef :
  1115. write_rtti(tarraydef(def).elementdef,rt);
  1116. recorddef :
  1117. fields_write_rtti(trecorddef(def).symtable,rt);
  1118. objectdef :
  1119. begin
  1120. if assigned(tobjectdef(def).childof) then
  1121. write_rtti(tobjectdef(def).childof,rt);
  1122. if rt=initrtti then
  1123. fields_write_rtti(tobjectdef(def).symtable,rt)
  1124. else
  1125. published_write_rtti(tobjectdef(def).symtable,rt);
  1126. end;
  1127. end;
  1128. end;
  1129. function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
  1130. begin
  1131. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
  1132. end;
  1133. procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
  1134. var
  1135. rttilab : tasmsymbol;
  1136. begin
  1137. { only write rtti of definitions from the current module }
  1138. if not findunitsymtable(def.owner).iscurrentunit then
  1139. exit;
  1140. { prevent recursion }
  1141. if rttidefstate[rt] in def.defstates then
  1142. exit;
  1143. include(def.defstates,rttidefstate[rt]);
  1144. { write first all dependencies }
  1145. write_child_rtti_data(def,rt);
  1146. { write rtti data }
  1147. rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
  1148. maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
  1149. new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1150. current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
  1151. write_rtti_data(def,rt);
  1152. current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
  1153. write_rtti_extrasyms(def,rt,rttilab);
  1154. end;
  1155. function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
  1156. begin
  1157. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
  1158. end;
  1159. function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
  1160. begin
  1161. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s');
  1162. end;
  1163. function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
  1164. begin
  1165. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o');
  1166. end;
  1167. end.