2
0

ncgrtti.pas 55 KB

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