ncgrtti.pas 54 KB

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