ncgrtti.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277
  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. vs_constref: paraspec := pfConstRef;
  612. end;
  613. { Kylix also seems to always add both pfArray and pfReference
  614. in this case
  615. }
  616. if is_open_array(parasym.vardef) then
  617. paraspec:=paraspec or pfArray or pfReference;
  618. { and these for classes and interfaces (maybe because they
  619. are themselves addresses?)
  620. }
  621. if is_class_or_interface(parasym.vardef) then
  622. paraspec:=paraspec or pfAddress;
  623. { set bits run from the highest to the lowest bit on
  624. big endian systems
  625. }
  626. if (target_info.endian = endian_big) then
  627. paraspec:=reverse_byte(paraspec);
  628. { write flags for current parameter }
  629. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
  630. { write name of current parameter }
  631. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(parasym.realname)));
  632. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(parasym.realname));
  633. { write name of type of current parameter }
  634. write_rtti_name(parasym.vardef);
  635. end;
  636. end;
  637. var
  638. methodkind : byte;
  639. i : integer;
  640. begin
  641. if po_methodpointer in def.procoptions then
  642. begin
  643. { write method id and name }
  644. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkmethod));
  645. write_rtti_name(def);
  646. if (tf_requires_proper_alignment in target_info.flags) then
  647. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  648. { write kind of method }
  649. case def.proctypeoption of
  650. potype_constructor: methodkind:=mkConstructor;
  651. potype_destructor: methodkind:=mkDestructor;
  652. potype_class_constructor: methodkind:=mkClassConstructor;
  653. potype_class_destructor: methodkind:=mkClassDestructor;
  654. potype_procedure:
  655. if po_classmethod in def.procoptions then
  656. methodkind:=mkClassProcedure
  657. else
  658. methodkind:=mkProcedure;
  659. potype_function:
  660. if po_classmethod in def.procoptions then
  661. methodkind:=mkClassFunction
  662. else
  663. methodkind:=mkFunction;
  664. else
  665. begin
  666. if def.returndef = voidtype then
  667. methodkind:=mkProcedure
  668. else
  669. methodkind:=mkFunction;
  670. end;
  671. end;
  672. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
  673. { write parameter info. The parameters must be written in reverse order
  674. if this method uses right to left parameter pushing! }
  675. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
  676. for i:=0 to def.paras.count-1 do
  677. write_para(tparavarsym(def.paras[i]));
  678. if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
  679. begin
  680. { write name of result type }
  681. write_rtti_name(def.returndef);
  682. if (tf_requires_proper_alignment in target_info.flags) then
  683. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
  684. { write result typeinfo }
  685. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti)))
  686. end;
  687. { write calling convention }
  688. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
  689. if (tf_requires_proper_alignment in target_info.flags) then
  690. current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
  691. { write params typeinfo }
  692. for i:=0 to def.paras.count-1 do
  693. if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
  694. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti)));
  695. end
  696. else
  697. begin
  698. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkprocvar));
  699. write_rtti_name(def);
  700. end;
  701. end;
  702. procedure objectdef_rtti(def:tobjectdef);
  703. procedure objectdef_rtti_class_init(def:tobjectdef);
  704. begin
  705. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  706. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fields_count(def.symtable,rt)));
  707. fields_write_rtti_data(def.symtable,rt);
  708. end;
  709. procedure objectdef_rtti_interface_init(def:tobjectdef);
  710. begin
  711. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
  712. end;
  713. procedure objectdef_rtti_class_full(def:tobjectdef);
  714. var
  715. propnamelist : TFPHashObjectList;
  716. begin
  717. { Collect unique property names with nameindex }
  718. propnamelist:=TFPHashObjectList.Create;
  719. collect_propnamelist(propnamelist,def);
  720. if (oo_has_vmt in def.objectoptions) then
  721. current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
  722. else
  723. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  724. { write parent typeinfo }
  725. if assigned(def.childof) then
  726. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
  727. else
  728. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  729. { total number of unique properties }
  730. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
  731. { write unit name }
  732. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  733. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  734. if (tf_requires_proper_alignment in target_info.flags) then
  735. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  736. { write published properties for this object }
  737. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
  738. if (tf_requires_proper_alignment in target_info.flags) then
  739. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  740. published_properties_write_rtti_data(propnamelist,def.symtable);
  741. propnamelist.free;
  742. end;
  743. procedure objectdef_rtti_interface_full(def:tobjectdef);
  744. var
  745. i : longint;
  746. propnamelist : TFPHashObjectList;
  747. { if changed to a set, make sure it's still a byte large, and
  748. swap appropriately when cross-compiling
  749. }
  750. IntfFlags: byte;
  751. begin
  752. { Collect unique property names with nameindex }
  753. propnamelist:=TFPHashObjectList.Create;
  754. collect_propnamelist(propnamelist,def);
  755. { write parent typeinfo }
  756. if assigned(def.childof) then
  757. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti)))
  758. else
  759. current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
  760. { interface: write flags, iid and iidstr }
  761. IntfFlags:=0;
  762. if assigned(def.iidguid) then
  763. IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid));
  764. if assigned(def.iidstr) then
  765. IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID));
  766. if (def.objecttype=odt_dispinterface) then
  767. IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface));
  768. if (target_info.endian=endian_big) then
  769. IntfFlags:=reverse_byte(IntfFlags);
  770. {
  771. ifDispatch, }
  772. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags));
  773. if (tf_requires_proper_alignment in target_info.flags) then
  774. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  775. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
  776. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2));
  777. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3));
  778. for i:=Low(def.iidguid^.D4) to High(def.iidguid^.D4) do
  779. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.iidguid^.D4[i]));
  780. { write unit name }
  781. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
  782. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
  783. if (tf_requires_proper_alignment in target_info.flags) then
  784. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  785. { write iidstr }
  786. if assigned(def.iidstr) then
  787. begin
  788. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.iidstr^)));
  789. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.iidstr^));
  790. end
  791. else
  792. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
  793. if (tf_requires_proper_alignment in target_info.flags) then
  794. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  795. { write published properties for this object }
  796. published_properties_write_rtti_data(propnamelist,def.symtable);
  797. propnamelist.free;
  798. end;
  799. begin
  800. case def.objecttype of
  801. odt_class:
  802. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
  803. odt_object:
  804. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject));
  805. odt_dispinterface,
  806. odt_interfacecom:
  807. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
  808. odt_interfacecorba:
  809. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
  810. else
  811. internalerror(200611034);
  812. end;
  813. { generate the name }
  814. current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.objrealname^)));
  815. current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.objrealname^));
  816. if (tf_requires_proper_alignment in target_info.flags) then
  817. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  818. case rt of
  819. initrtti :
  820. begin
  821. if def.objecttype in [odt_class,odt_object] then
  822. objectdef_rtti_class_init(def)
  823. else
  824. objectdef_rtti_interface_init(def);
  825. end;
  826. fullrtti :
  827. begin
  828. if def.objecttype in [odt_class,odt_object] then
  829. objectdef_rtti_class_full(def)
  830. else
  831. objectdef_rtti_interface_full(def);
  832. end;
  833. end;
  834. end;
  835. begin
  836. case def.typ of
  837. variantdef :
  838. variantdef_rtti(tvariantdef(def));
  839. stringdef :
  840. stringdef_rtti(tstringdef(def));
  841. enumdef :
  842. enumdef_rtti(tenumdef(def));
  843. orddef :
  844. orddef_rtti(torddef(def));
  845. floatdef :
  846. floatdef_rtti(tfloatdef(def));
  847. setdef :
  848. setdef_rtti(tsetdef(def));
  849. procvardef :
  850. procvardef_rtti(tprocvardef(def));
  851. arraydef :
  852. begin
  853. if ado_IsBitPacked in tarraydef(def).arrayoptions then
  854. unknown_rtti(tstoreddef(def))
  855. else
  856. arraydef_rtti(tarraydef(def));
  857. end;
  858. recorddef :
  859. begin
  860. if trecorddef(def).is_packed then
  861. unknown_rtti(tstoreddef(def))
  862. else
  863. recorddef_rtti(trecorddef(def));
  864. end;
  865. objectdef :
  866. objectdef_rtti(tobjectdef(def));
  867. else
  868. unknown_rtti(tstoreddef(def));
  869. end;
  870. end;
  871. procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
  872. procedure enumdef_rtti_ord2stringindex(def:Tenumdef);
  873. var rttilab:Tasmsymbol;
  874. t:Tenumsym;
  875. syms:^Tenumsym;
  876. offsets:^longint;
  877. sym_count,sym_alloc:longint;
  878. h,i,p,o,st:longint;
  879. mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
  880. r:single; {Must be real type because of integer overflow risk.}
  881. begin
  882. {Random access needed, put in array.}
  883. getmem(syms,64*sizeof(Tenumsym));
  884. getmem(offsets,64*sizeof(longint));
  885. sym_count:=0;
  886. sym_alloc:=64;
  887. st:=0;
  888. for i := 0 to def.symtable.SymList.Count - 1 do
  889. begin
  890. t:=tenumsym(def.symtable.SymList[i]);
  891. if t.value<def.minval then
  892. continue
  893. else
  894. if t.value>def.maxval then
  895. break;
  896. if sym_count>=sym_alloc then
  897. begin
  898. reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
  899. reallocmem(offsets,2*sym_alloc*sizeof(longint));
  900. sym_alloc:=sym_alloc*2;
  901. end;
  902. syms[sym_count]:=t;
  903. offsets[sym_count]:=st;
  904. inc(sym_count);
  905. st:=st+length(t.realname)+1;
  906. end;
  907. {Sort the syms by enum value}
  908. if sym_count>=2 then
  909. begin
  910. p:=1;
  911. while 2*p<sym_count do
  912. p:=2*p;
  913. while p<>0 do
  914. begin
  915. for h:=p to sym_count-1 do
  916. begin
  917. i:=h;
  918. t:=syms[i];
  919. o:=offsets[i];
  920. repeat
  921. if syms[i-p].value<=t.value then
  922. break;
  923. syms[i]:=syms[i-p];
  924. offsets[i]:=offsets[i-p];
  925. dec(i,p);
  926. until i<p;
  927. syms[i]:=t;
  928. offsets[i]:=o;
  929. end;
  930. p:=p shr 1;
  931. end;
  932. end;
  933. {Decide wether a lookup array is size efficient.}
  934. mode:=lookup;
  935. if sym_count>0 then
  936. begin
  937. i:=1;
  938. r:=0;
  939. h:=syms[0].value; {Next expected enum value is min.}
  940. while i<sym_count do
  941. begin
  942. {Calculate size of hole between values. Avoid integer overflows.}
  943. r:=r+(single(syms[i].value)-single(h))-1;
  944. h:=syms[i].value;
  945. inc(i);
  946. end;
  947. if r>sym_count then
  948. mode:=search; {Don't waste more than 50% space.}
  949. end;
  950. {Calculate start of string table.}
  951. st:=1;
  952. if assigned(def.typesym) then
  953. inc(st,length(def.typesym.realname)+1)
  954. else
  955. inc(st);
  956. if (tf_requires_proper_alignment in target_info.flags) then
  957. st:=align(st,sizeof(Tconstptruint));
  958. inc(st);
  959. if (tf_requires_proper_alignment in target_info.flags) then
  960. st:=align(st,sizeof(Tconstptruint));
  961. inc(st,8+sizeof(pint));
  962. { write rtti data }
  963. with current_asmdata do
  964. begin
  965. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
  966. maybe_new_object_file(asmlists[al_rtti]);
  967. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  968. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  969. asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
  970. if mode=lookup then
  971. begin
  972. if (tf_requires_proper_alignment in target_info.flags) then
  973. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  974. o:=syms[0].value; {Start with min value.}
  975. for i:=0 to sym_count-1 do
  976. begin
  977. while o<syms[i].value do
  978. begin
  979. asmlists[al_rtti].concat(Tai_const.create_pint(0));
  980. inc(o);
  981. end;
  982. inc(o);
  983. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  984. end;
  985. end
  986. else
  987. begin
  988. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  989. for i:=0 to sym_count-1 do
  990. begin
  991. if (tf_requires_proper_alignment in target_info.flags) then
  992. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
  993. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  994. if (tf_requires_proper_alignment in target_info.flags) then
  995. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  996. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  997. end;
  998. end;
  999. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  1000. end;
  1001. freemem(syms);
  1002. freemem(offsets);
  1003. end;
  1004. procedure enumdef_rtti_string2ordindex(def:Tenumdef);
  1005. var rttilab:Tasmsymbol;
  1006. t:Tenumsym;
  1007. syms:^Tenumsym;
  1008. offsets:^longint;
  1009. sym_count,sym_alloc:longint;
  1010. h,i,p,o,st:longint;
  1011. begin
  1012. {Random access needed, put in array.}
  1013. getmem(syms,64*sizeof(Tenumsym));
  1014. getmem(offsets,64*sizeof(longint));
  1015. sym_count:=0;
  1016. sym_alloc:=64;
  1017. st:=0;
  1018. for i := 0 to def.symtable.SymList.Count - 1 do
  1019. begin
  1020. t:=tenumsym(def.symtable.SymList[i]);
  1021. if t.value<def.minval then
  1022. continue
  1023. else
  1024. if t.value>def.maxval then
  1025. break;
  1026. if sym_count>=sym_alloc then
  1027. begin
  1028. reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
  1029. reallocmem(offsets,2*sym_alloc*sizeof(longint));
  1030. sym_alloc:=sym_alloc*2;
  1031. end;
  1032. syms[sym_count]:=t;
  1033. offsets[sym_count]:=st;
  1034. inc(sym_count);
  1035. st:=st+length(t.realname)+1;
  1036. end;
  1037. {Sort the syms by enum name}
  1038. if sym_count>=2 then
  1039. begin
  1040. p:=1;
  1041. while 2*p<sym_count do
  1042. p:=2*p;
  1043. while p<>0 do
  1044. begin
  1045. for h:=p to sym_count-1 do
  1046. begin
  1047. i:=h;
  1048. t:=syms[i];
  1049. o:=offsets[i];
  1050. repeat
  1051. if syms[i-p].name<=t.name then
  1052. break;
  1053. syms[i]:=syms[i-p];
  1054. offsets[i]:=offsets[i-p];
  1055. dec(i,p);
  1056. until i<p;
  1057. syms[i]:=t;
  1058. offsets[i]:=o;
  1059. end;
  1060. p:=p shr 1;
  1061. end;
  1062. end;
  1063. {Calculate start of string table.}
  1064. st:=1;
  1065. if assigned(def.typesym) then
  1066. inc(st,length(def.typesym.realname)+1)
  1067. else
  1068. inc(st);
  1069. if (tf_requires_proper_alignment in target_info.flags) then
  1070. st:=align(st,sizeof(Tconstptruint));
  1071. inc(st);
  1072. if (tf_requires_proper_alignment in target_info.flags) then
  1073. st:=align(st,sizeof(Tconstptruint));
  1074. inc(st,8+sizeof(pint));
  1075. { write rtti data }
  1076. with current_asmdata do
  1077. begin
  1078. rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
  1079. maybe_new_object_file(asmlists[al_rtti]);
  1080. new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1081. asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
  1082. asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
  1083. for i:=0 to sym_count-1 do
  1084. begin
  1085. if (tf_requires_proper_alignment in target_info.flags) then
  1086. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
  1087. asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
  1088. if (tf_requires_proper_alignment in target_info.flags) then
  1089. current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
  1090. asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
  1091. end;
  1092. asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
  1093. end;
  1094. freemem(syms);
  1095. freemem(offsets);
  1096. end;
  1097. begin
  1098. case def.typ of
  1099. enumdef:
  1100. if rt=fullrtti then
  1101. begin
  1102. enumdef_rtti_ord2stringindex(Tenumdef(def));
  1103. enumdef_rtti_string2ordindex(Tenumdef(def));
  1104. end;
  1105. end;
  1106. end;
  1107. procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
  1108. begin
  1109. case def.typ of
  1110. enumdef :
  1111. if assigned(tenumdef(def).basedef) then
  1112. write_rtti(tenumdef(def).basedef,rt);
  1113. setdef :
  1114. write_rtti(tsetdef(def).elementdef,rt);
  1115. arraydef :
  1116. write_rtti(tarraydef(def).elementdef,rt);
  1117. recorddef :
  1118. fields_write_rtti(trecorddef(def).symtable,rt);
  1119. objectdef :
  1120. begin
  1121. if assigned(tobjectdef(def).childof) then
  1122. write_rtti(tobjectdef(def).childof,rt);
  1123. if rt=initrtti then
  1124. fields_write_rtti(tobjectdef(def).symtable,rt)
  1125. else
  1126. published_write_rtti(tobjectdef(def).symtable,rt);
  1127. end;
  1128. end;
  1129. end;
  1130. function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
  1131. begin
  1132. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
  1133. end;
  1134. procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
  1135. var
  1136. rttilab : tasmsymbol;
  1137. begin
  1138. { only write rtti of definitions from the current module }
  1139. if not findunitsymtable(def.owner).iscurrentunit then
  1140. exit;
  1141. { prevent recursion }
  1142. if rttidefstate[rt] in def.defstates then
  1143. exit;
  1144. include(def.defstates,rttidefstate[rt]);
  1145. { write first all dependencies }
  1146. write_child_rtti_data(def,rt);
  1147. { write rtti data }
  1148. rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
  1149. maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
  1150. new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
  1151. current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
  1152. write_rtti_data(def,rt);
  1153. current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
  1154. write_rtti_extrasyms(def,rt,rttilab);
  1155. end;
  1156. function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
  1157. begin
  1158. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
  1159. end;
  1160. function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
  1161. begin
  1162. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s');
  1163. end;
  1164. function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
  1165. begin
  1166. result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o');
  1167. end;
  1168. end.