ncgcon.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Generate assembler for constant nodes which are the same for
  4. all (most) processors
  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 ncgcon;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,ncon;
  23. type
  24. tcgdataconstnode = class(tdataconstnode)
  25. procedure pass_generate_code;override;
  26. end;
  27. tcgrealconstnode = class(trealconstnode)
  28. procedure pass_generate_code;override;
  29. end;
  30. tcgordconstnode = class(tordconstnode)
  31. procedure pass_generate_code;override;
  32. end;
  33. tcgpointerconstnode = class(tpointerconstnode)
  34. procedure pass_generate_code;override;
  35. end;
  36. tcgstringconstnode = class(tstringconstnode)
  37. procedure pass_generate_code;override;
  38. end;
  39. tcgsetconstnode = class(tsetconstnode)
  40. procedure pass_generate_code;override;
  41. end;
  42. tcgnilnode = class(tnilnode)
  43. procedure pass_generate_code;override;
  44. end;
  45. tcgguidconstnode = class(tguidconstnode)
  46. procedure pass_generate_code;override;
  47. end;
  48. implementation
  49. uses
  50. globtype,widestr,systems,
  51. verbose,globals,cutils,
  52. symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
  53. cpuinfo,cpubase,
  54. cgbase,cgobj,cgutils,
  55. ncgutil, cclasses,asmutils
  56. ;
  57. {*****************************************************************************
  58. TCGREALCONSTNODE
  59. *****************************************************************************}
  60. procedure tcgdataconstnode.pass_generate_code;
  61. var
  62. l : tasmlabel;
  63. i : longint;
  64. b : byte;
  65. begin
  66. location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(maxalign));
  67. current_asmdata.getdatalabel(l);
  68. maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
  69. new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,l.name,const_align(maxalign));
  70. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l));
  71. data.seek(0);
  72. for i:=0 to data.size-1 do
  73. begin
  74. data.read(b,1);
  75. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(b));
  76. end;
  77. location.reference.symbol:=l;
  78. end;
  79. {*****************************************************************************
  80. TCGREALCONSTNODE
  81. *****************************************************************************}
  82. procedure tcgrealconstnode.pass_generate_code;
  83. { I suppose the parser/pass_1 must make sure the generated real }
  84. { constants are actually supported by the target processor? (JM) }
  85. const
  86. floattype2ait:array[tfloattype] of taitype=
  87. (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
  88. { Since the value is stored always as bestreal, we share a single pool
  89. between all float types. This requires type and hiloswapped flag to
  90. be matched along with the value }
  91. type
  92. tfloatkey = record
  93. value: bestreal;
  94. typ: tfloattype;
  95. swapped: boolean;
  96. end;
  97. var
  98. lastlabel : tasmlabel;
  99. realait : taitype;
  100. entry : PHashSetItem;
  101. key: tfloatkey;
  102. {$ifdef ARM}
  103. hiloswapped : boolean;
  104. {$endif ARM}
  105. begin
  106. location_reset_ref(location,LOC_CREFERENCE,def_cgsize(resultdef),const_align(resultdef.alignment));
  107. lastlabel:=nil;
  108. realait:=floattype2ait[tfloatdef(resultdef).floattype];
  109. {$ifdef ARM}
  110. hiloswapped:=is_double_hilo_swapped;
  111. {$endif ARM}
  112. { const already used ? }
  113. if not assigned(lab_real) then
  114. begin
  115. { there may be gap between record fields, zero it out }
  116. fillchar(key,sizeof(key),0);
  117. key.value:=value_real;
  118. key.typ:=tfloatdef(resultdef).floattype;
  119. {$ifdef ARM}
  120. key.swapped:=hiloswapped;
  121. {$endif ARM}
  122. entry := current_asmdata.ConstPools[sp_floats].FindOrAdd(@key, sizeof(key));
  123. lab_real := TAsmLabel(entry^.Data); // is it needed anymore?
  124. { :-(, we must generate a new entry }
  125. if not assigned(lab_real) then
  126. begin
  127. current_asmdata.getdatalabel(lastlabel);
  128. entry^.Data:=lastlabel;
  129. lab_real:=lastlabel;
  130. maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
  131. new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(resultdef.alignment));
  132. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
  133. case realait of
  134. ait_real_32bit :
  135. begin
  136. current_asmdata.asmlists[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real)));
  137. { range checking? }
  138. if floating_point_range_check_error and
  139. (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
  140. Message(parser_e_range_check_error);
  141. end;
  142. ait_real_64bit :
  143. begin
  144. {$ifdef ARM}
  145. if hiloswapped then
  146. current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
  147. else
  148. {$endif ARM}
  149. current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real)));
  150. { range checking? }
  151. if floating_point_range_check_error and
  152. (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
  153. Message(parser_e_range_check_error);
  154. end;
  155. ait_real_80bit :
  156. begin
  157. current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real,resultdef.size));
  158. { range checking? }
  159. if floating_point_range_check_error and
  160. (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
  161. Message(parser_e_range_check_error);
  162. end;
  163. {$ifdef cpufloat128}
  164. ait_real_128bit :
  165. begin
  166. current_asmdata.asmlists[al_typedconsts].concat(Tai_real_128bit.Create(value_real));
  167. { range checking? }
  168. if floating_point_range_check_error and
  169. (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
  170. Message(parser_e_range_check_error);
  171. end;
  172. {$endif cpufloat128}
  173. { the round is necessary for native compilers where comp isn't a float }
  174. ait_comp_64bit :
  175. if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
  176. message(parser_e_range_check_error)
  177. else
  178. current_asmdata.asmlists[al_typedconsts].concat(Tai_comp_64bit.Create(round(value_real)));
  179. else
  180. internalerror(10120);
  181. end;
  182. end;
  183. end;
  184. location.reference.symbol:=lab_real;
  185. end;
  186. {*****************************************************************************
  187. TCGORDCONSTNODE
  188. *****************************************************************************}
  189. procedure tcgordconstnode.pass_generate_code;
  190. begin
  191. location_reset(location,LOC_CONSTANT,def_cgsize(resultdef));
  192. {$ifdef cpu64bitalu}
  193. location.value:=value.svalue;
  194. {$else cpu64bitalu}
  195. location.value64:=value.svalue;
  196. {$endif cpu64bitalu}
  197. end;
  198. {*****************************************************************************
  199. TCGPOINTERCONSTNODE
  200. *****************************************************************************}
  201. procedure tcgpointerconstnode.pass_generate_code;
  202. begin
  203. { an integer const. behaves as a memory reference }
  204. location_reset(location,LOC_CONSTANT,OS_ADDR);
  205. location.value:=aint(value);
  206. end;
  207. {*****************************************************************************
  208. TCGSTRINGCONSTNODE
  209. *****************************************************************************}
  210. procedure tcgstringconstnode.pass_generate_code;
  211. var
  212. lastlabel: tasmlabel;
  213. pc: pchar;
  214. l: longint;
  215. href: treference;
  216. pool: THashSet;
  217. entry: PHashSetItem;
  218. cp: tstringencoding;
  219. const
  220. PoolMap: array[tconststringtype] of TConstPoolType = (
  221. sp_conststr,
  222. sp_shortstr,
  223. sp_longstr,
  224. sp_ansistr,
  225. sp_widestr,
  226. sp_unicodestr
  227. );
  228. begin
  229. { for empty ansistrings we could return a constant 0 }
  230. if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) and (len=0) then
  231. begin
  232. location_reset(location,LOC_CONSTANT,OS_ADDR);
  233. location.value:=0;
  234. exit;
  235. end;
  236. { const already used ? }
  237. if not assigned(lab_str) then
  238. begin
  239. pool := current_asmdata.ConstPools[PoolMap[cst_type]];
  240. if cst_type in [cst_widestring, cst_unicodestring] then
  241. entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data,len*cwidechartype.size)
  242. else
  243. if cst_type = cst_ansistring then
  244. begin
  245. cp:=tstringdef(resultdef).encoding;
  246. { force output of RawByteString constants in CP_ACP codepage }
  247. if cp=CP_NONE then
  248. cp:=0;
  249. { for delphiuncode mode output CP_ACP constants in the compiler codepage }
  250. if (cp=0) and (cs_explicit_codepage in current_settings.moduleswitches) then
  251. cp:=current_settings.sourcecodepage;
  252. entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(value_str,len,cp))
  253. end
  254. else
  255. entry := pool.FindOrAdd(value_str,len);
  256. lab_str := TAsmLabel(entry^.Data); // is it needed anymore?
  257. { :-(, we must generate a new entry }
  258. if not assigned(entry^.Data) then
  259. begin
  260. case cst_type of
  261. cst_ansistring:
  262. begin
  263. if len=0 then
  264. InternalError(2008032301) { empty string should be handled above }
  265. else
  266. lastlabel:=emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,cp);
  267. end;
  268. cst_unicodestring,
  269. cst_widestring:
  270. begin
  271. if len=0 then
  272. InternalError(2008032302) { empty string should be handled above }
  273. else
  274. lastlabel := emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
  275. value_str,
  276. tstringdef(resultdef).encoding,
  277. (cst_type=cst_widestring) and (tf_winlikewidestring in target_info.flags));
  278. end;
  279. cst_shortstring:
  280. begin
  281. current_asmdata.getdatalabel(lastlabel);
  282. maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
  283. new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint)));
  284. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
  285. { truncate strings larger than 255 chars }
  286. if len>255 then
  287. l:=255
  288. else
  289. l:=len;
  290. { include length and terminating zero for quick conversion to pchar }
  291. getmem(pc,l+2);
  292. move(value_str^,pc[1],l);
  293. pc[0]:=chr(l);
  294. pc[l+1]:=#0;
  295. current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,l+2));
  296. end;
  297. cst_conststring:
  298. begin
  299. current_asmdata.getdatalabel(lastlabel);
  300. maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
  301. new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint)));
  302. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
  303. { include terminating zero }
  304. getmem(pc,len+1);
  305. move(value_str^,pc[0],len);
  306. pc[len]:=#0;
  307. current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1));
  308. end;
  309. end;
  310. lab_str:=lastlabel;
  311. entry^.Data:=lastlabel;
  312. end;
  313. end;
  314. if cst_type in [cst_ansistring, cst_widestring, cst_unicodestring] then
  315. begin
  316. location_reset(location, LOC_REGISTER, OS_ADDR);
  317. reference_reset_symbol(href, lab_str, 0, const_align(sizeof(pint)));
  318. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  319. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,location.register);
  320. end
  321. else
  322. begin
  323. location_reset_ref(location, LOC_CREFERENCE, def_cgsize(resultdef), const_align(sizeof(pint)));
  324. location.reference.symbol:=lab_str;
  325. end;
  326. end;
  327. {*****************************************************************************
  328. TCGSETCONSTNODE
  329. *****************************************************************************}
  330. procedure tcgsetconstnode.pass_generate_code;
  331. type
  332. setbytes=array[0..31] of byte;
  333. Psetbytes=^setbytes;
  334. procedure smallsetconst;
  335. begin
  336. location_reset(location,LOC_CONSTANT,int_cgsize(resultdef.size));
  337. if (source_info.endian=target_info.endian) then
  338. begin
  339. { not plongint, because that will "sign extend" the set on 64 bit platforms }
  340. { if changed to "paword", please also modify "32-resultdef.size*8" and }
  341. { cross-endian code below }
  342. { Extra aint type cast to avoid range errors }
  343. location.value:=aint(pCardinal(value_set)^)
  344. end
  345. else
  346. begin
  347. location.value:=swapendian(Pcardinal(value_set)^);
  348. location.value:=aint(
  349. reverse_byte (location.value and $ff) or
  350. (reverse_byte((location.value shr 8) and $ff) shl 8) or
  351. (reverse_byte((location.value shr 16) and $ff) shl 16) or
  352. (reverse_byte((location.value shr 24) and $ff) shl 24)
  353. );
  354. end;
  355. if (target_info.endian=endian_big) then
  356. location.value:=location.value shr (32-resultdef.size*8);
  357. end;
  358. procedure varsetconst;
  359. var
  360. lastlabel : tasmlabel;
  361. i : longint;
  362. entry : PHashSetItem;
  363. begin
  364. location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(8));
  365. lastlabel:=nil;
  366. { const already used ? }
  367. if not assigned(lab_set) then
  368. begin
  369. entry := current_asmdata.ConstPools[sp_varsets].FindOrAdd(value_set, 32);
  370. lab_set := TAsmLabel(entry^.Data); // is it needed anymore?
  371. { :-(, we must generate a new entry }
  372. if not assigned(entry^.Data) then
  373. begin
  374. current_asmdata.getdatalabel(lastlabel);
  375. lab_set:=lastlabel;
  376. entry^.Data:=lastlabel;
  377. maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
  378. new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(8));
  379. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
  380. if (source_info.endian=target_info.endian) then
  381. for i:=0 to 31 do
  382. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
  383. else
  384. for i:=0 to 31 do
  385. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
  386. end;
  387. end;
  388. location.reference.symbol:=lab_set;
  389. end;
  390. begin
  391. adjustforsetbase;
  392. { small sets are loaded as constants }
  393. if is_smallset(resultdef) then
  394. smallsetconst
  395. else
  396. varsetconst;
  397. end;
  398. {*****************************************************************************
  399. TCGNILNODE
  400. *****************************************************************************}
  401. procedure tcgnilnode.pass_generate_code;
  402. begin
  403. location_reset(location,LOC_CONSTANT,OS_ADDR);
  404. location.value:=0;
  405. end;
  406. {*****************************************************************************
  407. TCGPOINTERCONSTNODE
  408. *****************************************************************************}
  409. procedure tcgguidconstnode.pass_generate_code;
  410. var
  411. tmplabel : TAsmLabel;
  412. i : integer;
  413. begin
  414. location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(16));
  415. { label for GUID }
  416. current_asmdata.getdatalabel(tmplabel);
  417. current_asmdata.asmlists[al_typedconsts].concat(tai_align.create(const_align(16)));
  418. current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(tmplabel));
  419. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(longint(value.D1)));
  420. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(value.D2));
  421. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(value.D3));
  422. for i:=low(value.D4) to high(value.D4) do
  423. current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(value.D4[i]));
  424. location.reference.symbol:=tmplabel;
  425. end;
  426. begin
  427. cdataconstnode:=tcgdataconstnode;
  428. crealconstnode:=tcgrealconstnode;
  429. cordconstnode:=tcgordconstnode;
  430. cpointerconstnode:=tcgpointerconstnode;
  431. cstringconstnode:=tcgstringconstnode;
  432. csetconstnode:=tcgsetconstnode;
  433. cnilnode:=tcgnilnode;
  434. cguidconstnode:=tcgguidconstnode;
  435. end.