2
0

ncgrtti.pas 52 KB

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