aasmcnst.pas 28 KB

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