aasmcnst.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817
  1. {
  2. Copyright (c) 2014 by Jonas Maebe, member of the Free Pascal development
  3. team
  4. This unit implements typed constant data elements at the assembler level
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit aasmcnst;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,globtype,constexp,
  23. aasmbase,aasmdata,aasmtai,
  24. symconst,symtype,symdef,symsym;
  25. type
  26. { typed const: integer/floating point/string/pointer/... const along with
  27. tdef info }
  28. ttypedconstkind = (tck_simple, tck_array, tck_record);
  29. { the type of the element and its def }
  30. tai_abstracttypedconst = class abstract (tai)
  31. private
  32. procedure setdef(def: tdef);
  33. protected
  34. fadetyp: ttypedconstkind;
  35. { the def of this element }
  36. fdef: tdef;
  37. public
  38. constructor create(_adetyp: ttypedconstkind; _def: tdef);
  39. property adetyp: ttypedconstkind read fadetyp;
  40. property def: tdef read fdef write setdef;
  41. end;
  42. { a simple data element; the value is stored as a tai }
  43. tai_simpletypedconst = class(tai_abstracttypedconst)
  44. protected
  45. fval: tai;
  46. public
  47. constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
  48. property val: tai read fval;
  49. end;
  50. { an aggregate data element (record or array). Values are stored as an
  51. array of tsimpledataelement. }
  52. tai_aggregatetypedconst = class(tai_abstracttypedconst)
  53. public type
  54. { iterator to walk over all individual items in the aggregate }
  55. tadeenumerator = class(tobject)
  56. private
  57. fvalues: tfplist;
  58. fvaluespos: longint;
  59. function getcurrent: tai_abstracttypedconst;
  60. public
  61. constructor create(data: tai_aggregatetypedconst);
  62. function movenext: boolean;
  63. procedure reset;
  64. property current: tai_abstracttypedconst read getcurrent;
  65. end;
  66. protected
  67. fvalues: tfplist;
  68. fisstring: boolean;
  69. { converts the existing data to a single tai_string }
  70. procedure convert_to_string;
  71. procedure add_to_string(strtai: tai_string; othertai: tai);
  72. public
  73. constructor create(_adetyp: ttypedconstkind; _fdef: tdef);
  74. function getenumerator: tadeenumerator;
  75. procedure addvalue(val: tai_abstracttypedconst);
  76. procedure finish;
  77. destructor destroy; override;
  78. end;
  79. tasmlabofs = record
  80. lab: tasmlabel;
  81. ofs: asizeint;
  82. end;
  83. { Warning: never directly create a ttai_typedconstbuilder instance,
  84. instead create a cai_typedconstbuilder (this class can be overridden) }
  85. ttai_lowleveltypedconstbuilder = class abstract
  86. protected
  87. { temporary list in which all data is collected }
  88. fasmlist: tasmlist;
  89. { while queueing elements of a compound expression, this is the current
  90. offset in the top-level array/record }
  91. fqueue_offset: asizeint;
  92. { ensure that finalize_asmlist is called only once }
  93. fasmlist_finalized: boolean;
  94. { returns whether def must be handled as an aggregate on the current
  95. platform }
  96. function aggregate_kind(def: tdef): ttypedconstkind; virtual;
  97. { finalize the asmlist: add the necessary symbols etc }
  98. procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean); virtual;
  99. public
  100. constructor create; virtual;
  101. destructor destroy; override;
  102. { add a simple constant data element (p) to the typed constant.
  103. def is the type of the added value }
  104. procedure emit_tai(p: tai; def: tdef); virtual;
  105. { same as above, for a special case: when the def is a procvardef and we
  106. want to use it explicitly as a procdef (i.e., not as a record with a
  107. code and data pointer in case of a complex procvardef) }
  108. procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual;
  109. protected
  110. function emit_string_const_common(list: TAsmList; stringtype: tstringtype; len: asizeint; encoding: tstringencoding; out startlab: tasmlabel):tasmlabofs;
  111. public
  112. class function get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
  113. { class functions and an extra list parameter, because emitting the data
  114. for the strings has to happen via a separate typed const builder (which
  115. will be created/destroyed internally by these methods) }
  116. class function emit_ansistring_const(list: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding; newsection: boolean): tasmlabofs;
  117. class function emit_unicodestring_const(list: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
  118. { begin a potential aggregate type. Must be called for any type
  119. that consists of multiple tai constant data entries, or that
  120. represents an aggregate at the Pascal level (a record, a non-dynamic
  121. array, ... }
  122. procedure maybe_begin_aggregate(def: tdef); virtual;
  123. { end a potential aggregate type. Must be paired with every
  124. maybe_begin_aggregate }
  125. procedure maybe_end_aggregate(def: tdef); virtual;
  126. { similar as above, but in case
  127. a) it's definitely a record
  128. b) the def of the record should be automatically constructed based on
  129. the types of the emitted fields
  130. }
  131. procedure begin_anonymous_record; virtual;
  132. function end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef; virtual;
  133. { The next group of routines are for constructing complex expressions.
  134. While parsing a typed constant these operators are encountered from
  135. outer to inner, so that is also the order in which they should be
  136. added to the queue. Only one queue can be active at a time. }
  137. { Init the queue. Gives an internalerror if a queue was already active }
  138. procedure queue_init(todef: tdef); virtual;
  139. { queue an array/string indexing operation (performs all range checking,
  140. so it doesn't have to be duplicated in all descendents). }
  141. procedure queue_vecn(def: tdef; const index: tconstexprint); virtual;
  142. { queue a subscripting operation }
  143. procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual;
  144. { queue a type conversion operation }
  145. procedure queue_typeconvn(fromdef, todef: tdef); virtual;
  146. { queue an address taking operation }
  147. procedure queue_addrn(fromdef, todef: tdef); virtual;
  148. { finalise the queue (so a new one can be created) and flush the
  149. previously queued operations, applying them in reverse order on a...}
  150. { ... procdef }
  151. procedure queue_emit_proc(pd: tprocdef); virtual;
  152. { ... staticvarsym }
  153. procedure queue_emit_staticvar(vs: tstaticvarsym); virtual;
  154. { ... labelsym }
  155. procedure queue_emit_label(l: tlabelsym); virtual;
  156. { ... constsym }
  157. procedure queue_emit_const(cs: tconstsym); virtual;
  158. { ... asmsym/asmlabel }
  159. procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); virtual;
  160. { finalize the internal asmlist (if necessary) and return it.
  161. This asmlist will be freed when the builder is destroyed, so add its
  162. contents to another list first. This property should only be accessed
  163. once all data has been added. }
  164. function get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist;
  165. { returns the offset of the string data relative to ansi/unicode/widestring
  166. constant labels. On most platforms, this is 0 (with the header at a
  167. negative offset), but on some platforms such negative offsets are not
  168. supported this is equal to the header size }
  169. class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; virtual;
  170. protected
  171. { this one always return the actual offset, called by the above (and
  172. overridden versions) }
  173. class function get_string_header_size(typ: tstringtype; winlikewidestring: boolean): pint;
  174. end;
  175. ttai_lowleveltypedconstbuilderclass = class of ttai_lowleveltypedconstbuilder;
  176. var
  177. ctai_typedconstbuilder: ttai_lowleveltypedconstbuilderclass;
  178. implementation
  179. uses
  180. verbose,globals,systems,widestr,
  181. symtable,defutil;
  182. {****************************************************************************
  183. tai_abstracttypedconst
  184. ****************************************************************************}
  185. procedure tai_abstracttypedconst.setdef(def: tdef);
  186. begin
  187. { should not be changed, rewrite the calling code if this happens }
  188. if assigned(fdef) then
  189. Internalerror(2014080203);
  190. fdef:=def;
  191. end;
  192. constructor tai_abstracttypedconst.create(_adetyp: ttypedconstkind; _def: tdef);
  193. begin
  194. inherited create;
  195. typ:=ait_typedconst;
  196. fadetyp:=_adetyp;
  197. fdef:=_def;
  198. end;
  199. {****************************************************************************
  200. tai_simpletypedconst
  201. ****************************************************************************}
  202. constructor tai_simpletypedconst.create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
  203. begin
  204. inherited create(_adetyp,_def);
  205. fval:=_val;
  206. end;
  207. {****************************************************************************
  208. tai_aggregatetypedconst.tadeenumerator
  209. ****************************************************************************}
  210. constructor tai_aggregatetypedconst.tadeenumerator.create(data: tai_aggregatetypedconst);
  211. begin
  212. fvalues:=data.fvalues;
  213. fvaluespos:=-1;
  214. end;
  215. function tai_aggregatetypedconst.tadeenumerator.getcurrent: tai_abstracttypedconst;
  216. begin
  217. result:=tai_abstracttypedconst(fvalues[fvaluespos]);
  218. end;
  219. function tai_aggregatetypedconst.tadeenumerator.movenext: boolean;
  220. begin
  221. if fvaluespos<pred(fvalues.count) then
  222. begin
  223. inc(fvaluespos);
  224. result:=true
  225. end
  226. else
  227. result:=false;
  228. end;
  229. procedure tai_aggregatetypedconst.tadeenumerator.reset;
  230. begin
  231. fvaluespos:=0
  232. end;
  233. {****************************************************************************
  234. tai_aggregatetypedconst
  235. ****************************************************************************}
  236. procedure tai_aggregatetypedconst.convert_to_string;
  237. var
  238. ai: tai_abstracttypedconst;
  239. newstr: tai_string;
  240. begin
  241. newstr:=tai_string.Create('');
  242. for ai in self do
  243. begin
  244. if ai.adetyp<>tck_simple then
  245. internalerror(2014070103);
  246. add_to_string(newstr,tai_simpletypedconst(ai).val);
  247. ai.free;
  248. end;
  249. fvalues.count:=0;
  250. { the "nil" def will be replaced with an array def of the appropriate
  251. size once we're finished adding data, so we don't create intermediate
  252. arraydefs all the time }
  253. fvalues.add(tai_simpletypedconst.create(tck_simple,nil,newstr));
  254. end;
  255. procedure tai_aggregatetypedconst.add_to_string(strtai: tai_string; othertai: tai);
  256. begin
  257. case othertai.typ of
  258. ait_string:
  259. begin
  260. strtai.str:=reallocmem(strtai.str,strtai.len+tai_string(othertai).len+1);
  261. { also copy null terminator }
  262. move(tai_string(othertai).str[0],strtai.str[strtai.len],tai_string(othertai).len+1);
  263. { the null terminator is not part of the string data }
  264. strtai.len:=strtai.len+tai_string(othertai).len;
  265. end;
  266. ait_const:
  267. begin
  268. if tai_const(othertai).size<>1 then
  269. internalerror(2014070101);
  270. strtai.str:=reallocmem(strtai.str,strtai.len+1);
  271. strtai.str[strtai.len]:=ansichar(tai_const(othertai).value);
  272. strtai.str[strtai.len+1]:=#0;
  273. inc(strtai.len);
  274. end;
  275. else
  276. internalerror(2014070102);
  277. end;
  278. end;
  279. constructor tai_aggregatetypedconst.create(_adetyp: ttypedconstkind; _fdef: tdef);
  280. begin
  281. inherited;
  282. fisstring:=false;
  283. fvalues:=tfplist.create;
  284. end;
  285. function tai_aggregatetypedconst.getenumerator: tadeenumerator;
  286. begin
  287. result:=tadeenumerator.create(self);
  288. end;
  289. procedure tai_aggregatetypedconst.addvalue(val: tai_abstracttypedconst);
  290. begin
  291. { merge string constants and ordinal constants added in an array of
  292. char, to unify the length and the string data }
  293. if fisstring or
  294. ((val.adetyp=tck_simple) and
  295. (tai_simpletypedconst(val).val.typ=ait_string)) then
  296. begin
  297. if not fisstring and
  298. (fvalues.count>0) then
  299. convert_to_string;
  300. fisstring:=true;
  301. case fvalues.count of
  302. 0: fvalues.add(val);
  303. 1:
  304. begin
  305. add_to_string(tai_string(tai_simpletypedconst(fvalues[0]).val),tai_simpletypedconst(val).val);
  306. val.free
  307. end
  308. else
  309. internalerror(2014070104);
  310. end;
  311. end
  312. else
  313. fvalues.add(val);
  314. end;
  315. procedure tai_aggregatetypedconst.finish;
  316. begin
  317. if fisstring then
  318. begin
  319. { set the def: an array of char with the same length as the string
  320. data }
  321. if fvalues.count<>1 then
  322. internalerror(2014070105);
  323. tai_simpletypedconst(fvalues[0]).fdef:=
  324. getarraydef(cansichartype,
  325. tai_string(tai_simpletypedconst(fvalues[0]).val).len);
  326. end;
  327. end;
  328. destructor tai_aggregatetypedconst.destroy;
  329. begin
  330. fvalues.free;
  331. inherited destroy;
  332. end;
  333. {*****************************************************************************
  334. ttai_lowleveltypedconstbuilder
  335. *****************************************************************************}
  336. function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
  337. begin
  338. if (def.typ in [recorddef,filedef,variantdef]) or
  339. is_object(def) or
  340. ((def.typ=procvardef) and
  341. not tprocvardef(def).is_addressonly) then
  342. result:=tck_record
  343. else if ((def.typ=arraydef) and
  344. not is_dynamic_array(def)) or
  345. ((def.typ=setdef) and
  346. not is_smallset(def)) or
  347. is_shortstring(def) then
  348. result:=tck_array
  349. else
  350. result:=tck_simple;
  351. end;
  352. procedure ttai_lowleveltypedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean);
  353. var
  354. prelist: tasmlist;
  355. begin
  356. prelist:=tasmlist.create_without_marker;
  357. { only now add items based on the symbolname, because it may be
  358. modified by the "section" specifier in case of a typed constant }
  359. if section<>sec_none then
  360. begin
  361. maybe_new_object_file(prelist);
  362. new_section(prelist,section,secname,const_align(alignment));
  363. end;
  364. if not lab then
  365. if sym.bind=AB_GLOBAL then
  366. prelist.concat(tai_symbol.Create_Global(sym,0))
  367. else
  368. prelist.concat(tai_symbol.Create(sym,0))
  369. else
  370. prelist.concat(tai_label.Create(tasmlabel(sym)));
  371. { insert the symbol information before the data }
  372. fasmlist.insertlist(prelist);
  373. { end of the symbol }
  374. fasmlist.concat(tai_symbol_end.Createname(sym.name));
  375. { free the temporary list }
  376. prelist.free;
  377. end;
  378. function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist;
  379. begin
  380. if not fasmlist_finalized then
  381. begin
  382. finalize_asmlist(sym,def,section,secname,alignment,lab);
  383. fasmlist_finalized:=true;
  384. end;
  385. result:=fasmlist;
  386. end;
  387. class function ttai_lowleveltypedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
  388. begin
  389. { darwin's linker does not support negative offsets }
  390. if not(target_info.system in systems_darwin) then
  391. result:=0
  392. else
  393. result:=get_string_header_size(typ,winlikewidestring);
  394. end;
  395. class function ttai_lowleveltypedconstbuilder.get_string_header_size(typ: tstringtype; winlikewidestring: boolean): pint;
  396. const
  397. ansistring_header_size =
  398. { encoding }
  399. 2 +
  400. { elesize }
  401. 2 +
  402. {$ifdef cpu64bitaddr}
  403. { alignment }
  404. 4 +
  405. {$endif cpu64bitaddr}
  406. { reference count }
  407. sizeof(pint) +
  408. { length }
  409. sizeof(pint);
  410. unicodestring_header_size = ansistring_header_size;
  411. begin
  412. case typ of
  413. st_ansistring:
  414. result:=ansistring_header_size;
  415. st_unicodestring:
  416. result:=unicodestring_header_size;
  417. st_widestring:
  418. if winlikewidestring then
  419. result:=0
  420. else
  421. result:=unicodestring_header_size;
  422. else
  423. result:=0;
  424. end;
  425. end;
  426. constructor ttai_lowleveltypedconstbuilder.create;
  427. begin
  428. inherited create;
  429. fasmlist:=tasmlist.create_without_marker;
  430. { queue is empty }
  431. fqueue_offset:=low(fqueue_offset);
  432. end;
  433. destructor ttai_lowleveltypedconstbuilder.destroy;
  434. begin
  435. { the queue should have been flushed if it was used }
  436. if fqueue_offset<>low(fqueue_offset) then
  437. internalerror(2014062901);
  438. fasmlist.free;
  439. inherited destroy;
  440. end;
  441. procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef);
  442. begin
  443. { by default, we ignore the def info since we don't care about it at the
  444. the assembler level }
  445. fasmlist.concat(p);
  446. end;
  447. procedure ttai_lowleveltypedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
  448. begin
  449. { nothing special by default, since we don't care about the type }
  450. emit_tai(p,pvdef);
  451. end;
  452. function ttai_lowleveltypedconstbuilder.emit_string_const_common(list: TAsmList; stringtype: tstringtype; len: asizeint; encoding: tstringencoding; out startlab: tasmlabel): tasmlabofs;
  453. var
  454. string_symofs: asizeint;
  455. charptrdef: tdef;
  456. elesize: word;
  457. begin
  458. current_asmdata.getdatalabel(result.lab);
  459. startlab:=result.lab;
  460. result.ofs:=0;
  461. begin_anonymous_record;
  462. string_symofs:=get_string_symofs(stringtype,false);
  463. { encoding }
  464. emit_tai(tai_const.create_16bit(encoding),u16inttype);
  465. inc(result.ofs,2);
  466. { element size }
  467. case stringtype of
  468. st_ansistring:
  469. begin
  470. elesize:=1;
  471. charptrdef:=charpointertype;
  472. end;
  473. st_unicodestring:
  474. begin
  475. elesize:=2;
  476. charptrdef:=widecharpointertype;
  477. end
  478. else
  479. internalerror(2014080401);
  480. end;
  481. emit_tai(tai_const.create_16bit(elesize),u16inttype);
  482. inc(result.ofs,2);
  483. {$ifdef cpu64bitaddr}
  484. { dummy for alignment }
  485. emit_tai(tai_const.create_32bit(0),u32inttype);
  486. inc(result.ofs,4);
  487. {$endif cpu64bitaddr}
  488. emit_tai(tai_const.create_pint(-1),ptrsinttype);
  489. inc(result.ofs,sizeof(pint));
  490. emit_tai(tai_const.create_pint(len),ptrsinttype);
  491. inc(result.ofs,sizeof(pint));
  492. if string_symofs=0 then
  493. begin
  494. { results in slightly more efficient code }
  495. emit_tai(tai_label.create(result.lab),charptrdef);
  496. result.ofs:=0;
  497. current_asmdata.getdatalabel(startlab);
  498. end;
  499. { sanity check }
  500. if result.ofs<>string_symofs then
  501. internalerror(2012051701);
  502. end;
  503. class function ttai_lowleveltypedconstbuilder.get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
  504. begin
  505. case typ of
  506. st_ansistring:
  507. result:='ansistrrec';
  508. st_unicodestring,
  509. st_widestring:
  510. if (typ=st_unicodestring) or
  511. not winlike then
  512. result:='unicodestrrec'
  513. else
  514. result:='widestrrec';
  515. else
  516. internalerror(2014080402);
  517. end;
  518. result:=result+tostr(len);
  519. end;
  520. class function ttai_lowleveltypedconstbuilder.emit_ansistring_const(list: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding; newsection: boolean): tasmlabofs;
  521. var
  522. s: PChar;
  523. startlab: tasmlabel;
  524. sectype: TAsmSectiontype;
  525. ansistrrecdef: trecorddef;
  526. datadef: tdef;
  527. datatcb: ttai_lowleveltypedconstbuilder;
  528. begin
  529. datatcb:=self.create;
  530. result:=datatcb.emit_string_const_common(list,st_ansistring,len,encoding,startlab);
  531. getmem(s,len+1);
  532. move(data^,s^,len);
  533. s[len]:=#0;
  534. { terminating zero included }
  535. datadef:=getarraydef(cansichartype,len+1);
  536. datatcb.maybe_begin_aggregate(datadef);
  537. datatcb.emit_tai(tai_string.create_pchar(s,len+1),datadef);
  538. datatcb.maybe_end_aggregate(datadef);
  539. ansistrrecdef:=datatcb.end_anonymous_record('$'+get_dynstring_rec_name(st_ansistring,false,len),sizeof(pint));
  540. if NewSection then
  541. sectype:=sec_rodata_norel
  542. else
  543. sectype:=sec_none;
  544. list.concatlist(datatcb.get_final_asmlist(startlab,ansistrrecdef,sectype,startlab.name,const_align(sizeof(pint)),true));
  545. datatcb.free;
  546. end;
  547. class function ttai_lowleveltypedconstbuilder.emit_unicodestring_const(list: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
  548. var
  549. i, strlength: longint;
  550. string_symofs: asizeint;
  551. startlab: tasmlabel;
  552. datadef: tdef;
  553. uniwidestrrecdef: trecorddef;
  554. datatcb: ttai_lowleveltypedconstbuilder;
  555. begin
  556. datatcb:=self.create;
  557. strlength:=getlengthwidestring(pcompilerwidestring(data));
  558. if winlike then
  559. begin
  560. current_asmdata.getdatalabel(result.lab);
  561. datatcb.emit_tai(Tai_const.Create_32bit(strlength*cwidechartype.size),s32inttype);
  562. { can we optimise by placing the string constant label at the
  563. required offset? }
  564. string_symofs:=get_string_symofs(st_widestring,true);
  565. if string_symofs=0 then
  566. begin
  567. { yes }
  568. datatcb.emit_tai(Tai_label.Create(result.lab),widecharpointertype);
  569. { allocate a separate label for the start of the data }
  570. current_asmdata.getdatalabel(startlab);
  571. end;
  572. result.ofs:=string_symofs;
  573. end
  574. else
  575. begin
  576. result:=datatcb.emit_string_const_common(list,st_unicodestring,strlength,encoding,startlab);
  577. end;
  578. if cwidechartype.size = 2 then
  579. begin
  580. datadef:=getarraydef(cwidechartype,strlength+1);
  581. datatcb.maybe_begin_aggregate(datadef);
  582. for i:=0 to strlength-1 do
  583. datatcb.emit_tai(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]),cwidechartype);
  584. { ending #0 }
  585. datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
  586. datatcb.maybe_end_aggregate(datadef);
  587. uniwidestrrecdef:=datatcb.end_anonymous_record('$'+get_dynstring_rec_name(st_widestring,winlike,strlength),sizeof(pint));
  588. end
  589. else
  590. { code generation for other sizes must be written }
  591. internalerror(200904271);
  592. list.concatlist(datatcb.get_final_asmlist(startlab,uniwidestrrecdef,sec_rodata_norel,startlab.name,const_align(sizeof(pint)),true));
  593. datatcb.free;
  594. end;
  595. procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
  596. begin
  597. { do nothing }
  598. end;
  599. procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef);
  600. begin
  601. { do nothing }
  602. end;
  603. procedure ttai_lowleveltypedconstbuilder.begin_anonymous_record;
  604. begin
  605. { do nothing }
  606. end;
  607. function ttai_lowleveltypedconstbuilder.end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef;
  608. begin
  609. { do nothing }
  610. result:=nil;
  611. end;
  612. procedure ttai_lowleveltypedconstbuilder.queue_init(todef: tdef);
  613. begin
  614. { nested call to init? }
  615. if fqueue_offset<>low(fqueue_offset) then
  616. internalerror(2014062101);
  617. fqueue_offset:=0;
  618. end;
  619. procedure ttai_lowleveltypedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint);
  620. var
  621. elelen,
  622. vecbase: asizeint;
  623. v: tconstexprint;
  624. begin
  625. elelen:=1;
  626. vecbase:=0;
  627. case def.typ of
  628. stringdef :
  629. ;
  630. arraydef :
  631. begin
  632. if not is_packed_array(def) then
  633. begin
  634. elelen:=tarraydef(def).elesize;
  635. vecbase:=tarraydef(def).lowrange;
  636. end
  637. else
  638. Message(parser_e_packed_dynamic_open_array);
  639. end;
  640. else
  641. Message(parser_e_illegal_expression);
  642. end;
  643. { Prevent overflow }
  644. v:=index-vecbase;
  645. if (v<int64(low(fqueue_offset))) or (v>int64(high(fqueue_offset))) then
  646. message3(type_e_range_check_error_bounds,tostr(v),tostr(low(fqueue_offset)),tostr(high(fqueue_offset)));
  647. if high(fqueue_offset)-fqueue_offset div elelen>v then
  648. inc(fqueue_offset,elelen*v.svalue)
  649. else
  650. message3(type_e_range_check_error_bounds,tostr(index),tostr(vecbase),tostr(high(fqueue_offset)-fqueue_offset div elelen+vecbase))
  651. end;
  652. procedure ttai_lowleveltypedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
  653. begin
  654. inc(fqueue_offset,vs.fieldoffset);
  655. end;
  656. procedure ttai_lowleveltypedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
  657. begin
  658. { do nothing }
  659. end;
  660. procedure ttai_lowleveltypedconstbuilder.queue_addrn(fromdef, todef: tdef);
  661. begin
  662. { do nothing }
  663. end;
  664. procedure ttai_lowleveltypedconstbuilder.queue_emit_proc(pd: tprocdef);
  665. begin
  666. emit_tai(Tai_const.Createname(pd.mangledname,fqueue_offset),pd.getcopyas(procvardef,pc_address_only));
  667. fqueue_offset:=low(fqueue_offset);
  668. end;
  669. procedure ttai_lowleveltypedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
  670. begin
  671. { getpointerdef because we are emitting a pointer to the staticvarsym
  672. data, not the data itself }
  673. emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),getpointerdef(vs.vardef));
  674. fqueue_offset:=low(fqueue_offset);
  675. end;
  676. procedure ttai_lowleveltypedconstbuilder.queue_emit_label(l: tlabelsym);
  677. begin
  678. emit_tai(Tai_const.Createname(l.mangledname,fqueue_offset),voidcodepointertype);
  679. fqueue_offset:=low(fqueue_offset);
  680. end;
  681. procedure ttai_lowleveltypedconstbuilder.queue_emit_const(cs: tconstsym);
  682. begin
  683. if cs.consttyp<>constresourcestring then
  684. internalerror(2014062102);
  685. if fqueue_offset<>0 then
  686. internalerror(2014062103);
  687. { warning: update if/when the type of resource strings changes }
  688. emit_tai(Tai_const.Createname(make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA,sizeof(pint)),cansistringtype);
  689. fqueue_offset:=low(fqueue_offset);
  690. end;
  691. procedure ttai_lowleveltypedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
  692. begin
  693. { getpointerdef, because "sym" represents the address of whatever the
  694. data is }
  695. def:=getpointerdef(def);
  696. emit_tai(Tai_const.Create_sym_offset(sym,fqueue_offset),def);
  697. fqueue_offset:=low(fqueue_offset);
  698. end;
  699. begin
  700. ctai_typedconstbuilder:=ttai_lowleveltypedconstbuilder;
  701. end.