ncgrtti.pas 53 KB

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