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