ncgcon.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Generate assembler for constant nodes which are the same for
  5. all (most) processors
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit ncgcon;
  20. {$i fpcdefs.inc}
  21. interface
  22. uses
  23. node,ncon;
  24. type
  25. tcgrealconstnode = class(trealconstnode)
  26. procedure pass_2;override;
  27. end;
  28. tcgordconstnode = class(tordconstnode)
  29. procedure pass_2;override;
  30. end;
  31. tcgpointerconstnode = class(tpointerconstnode)
  32. procedure pass_2;override;
  33. end;
  34. tcgstringconstnode = class(tstringconstnode)
  35. procedure pass_2;override;
  36. end;
  37. tcgsetconstnode = class(tsetconstnode)
  38. procedure pass_2;override;
  39. end;
  40. tcgnilnode = class(tnilnode)
  41. procedure pass_2;override;
  42. end;
  43. tcgguidconstnode = class(tguidconstnode)
  44. procedure pass_2;override;
  45. end;
  46. implementation
  47. uses
  48. globtype,widestr,systems,
  49. verbose,globals,
  50. symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
  51. cpuinfo,cpubase,
  52. cgbase,cgobj
  53. {$ifdef delphi}
  54. ,dmisc
  55. {$endif}
  56. ;
  57. {*****************************************************************************
  58. TCGREALCONSTNODE
  59. *****************************************************************************}
  60. procedure tcgrealconstnode.pass_2;
  61. { I suppose the parser/pass_1 must make sure the generated real }
  62. { constants are actually supported by the target processor? (JM) }
  63. const
  64. floattype2ait:array[tfloattype] of taitype=
  65. (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
  66. var
  67. hp1 : tai;
  68. lastlabel : tasmlabel;
  69. realait : taitype;
  70. {$ifdef ARM}
  71. hiloswapped : boolean;
  72. {$endif ARM}
  73. begin
  74. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  75. lastlabel:=nil;
  76. realait:=floattype2ait[tfloatdef(resulttype.def).typ];
  77. {$ifdef ARM}
  78. hiloswapped:=aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11];
  79. {$endif ARM}
  80. { const already used ? }
  81. if not assigned(lab_real) then
  82. begin
  83. { tries to find an old entry }
  84. hp1:=tai(Consts.first);
  85. while assigned(hp1) do
  86. begin
  87. if hp1.typ=ait_label then
  88. lastlabel:=tai_label(hp1).l
  89. else
  90. begin
  91. if (hp1.typ=realait) and (lastlabel<>nil) then
  92. begin
  93. if is_number_float(value_real) and
  94. (
  95. ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real) and is_number_float(tai_real_32bit(hp1).value)) or
  96. ((realait=ait_real_64bit) and
  97. {$ifdef ARM}
  98. ((tai_real_64bit(hp1).formatoptions=fo_hiloswapped)=hiloswapped) and
  99. {$endif ARM}
  100. (tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value)) or
  101. ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value)) or
  102. {$ifdef cpufloat128}
  103. ((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value)) or
  104. {$endif cpufloat128}
  105. ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real) and is_number_float(tai_comp_64bit(hp1).value))
  106. ) then
  107. begin
  108. { found! }
  109. lab_real:=lastlabel;
  110. break;
  111. end;
  112. end;
  113. lastlabel:=nil;
  114. end;
  115. hp1:=tai(hp1.next);
  116. end;
  117. { :-(, we must generate a new entry }
  118. if not assigned(lab_real) then
  119. begin
  120. objectlibrary.getdatalabel(lastlabel);
  121. lab_real:=lastlabel;
  122. if (cs_create_smart in aktmoduleswitches) then
  123. Consts.concat(Tai_cut.Create);
  124. consts.concat(tai_align.create(const_align(resulttype.def.size)));
  125. Consts.concat(Tai_label.Create(lastlabel));
  126. case realait of
  127. ait_real_32bit :
  128. Consts.concat(Tai_real_32bit.Create(ts32real(value_real)));
  129. ait_real_64bit :
  130. {$ifdef ARM}
  131. if hiloswapped then
  132. Consts.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
  133. else
  134. {$endif ARM}
  135. Consts.concat(Tai_real_64bit.Create(ts64real(value_real)));
  136. ait_real_80bit :
  137. Consts.concat(Tai_real_80bit.Create(value_real));
  138. {$ifdef cpufloat128}
  139. ait_real_128bit :
  140. Consts.concat(Tai_real_128bit.Create(value_real));
  141. {$endif cpufloat128}
  142. {$ifdef ver1_0}
  143. ait_comp_64bit :
  144. Consts.concat(Tai_comp_64bit.Create(value_real));
  145. {$else ver1_0}
  146. { the round is necessary for native compilers where comp isn't a float }
  147. ait_comp_64bit :
  148. begin
  149. if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
  150. Message(parser_e_range_check_error)
  151. else
  152. Consts.concat(Tai_comp_64bit.Create(round(value_real)));
  153. end;
  154. {$endif ver1_0}
  155. else
  156. internalerror(10120);
  157. end;
  158. end;
  159. end;
  160. location.reference.symbol:=lab_real;
  161. end;
  162. {*****************************************************************************
  163. TCGORDCONSTNODE
  164. *****************************************************************************}
  165. procedure tcgordconstnode.pass_2;
  166. begin
  167. location_reset(location,LOC_CONSTANT,def_cgsize(resulttype.def));
  168. location.valueqword:=TConstExprUInt(value);
  169. end;
  170. {*****************************************************************************
  171. TCGPOINTERCONSTNODE
  172. *****************************************************************************}
  173. procedure tcgpointerconstnode.pass_2;
  174. begin
  175. { an integer const. behaves as a memory reference }
  176. location_reset(location,LOC_CONSTANT,OS_ADDR);
  177. location.value:=AWord(value);
  178. end;
  179. {*****************************************************************************
  180. TCGSTRINGCONSTNODE
  181. *****************************************************************************}
  182. procedure tcgstringconstnode.pass_2;
  183. var
  184. hp1,hp2 : tai;
  185. l1,l2,
  186. lastlabel : tasmlabel;
  187. lastlabelhp : tai;
  188. pc : pchar;
  189. same_string : boolean;
  190. l,j,
  191. i,mylength : longint;
  192. begin
  193. { for empty ansistrings we could return a constant 0 }
  194. {$ifdef ansistring_bits}
  195. if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and (len=0) then
  196. {$else}
  197. if (st_type in [st_ansistring,st_widestring]) and (len=0) then
  198. {$endif}
  199. begin
  200. location_reset(location,LOC_CONSTANT,OS_ADDR);
  201. location.value:=0;
  202. exit;
  203. end;
  204. { return a constant reference in memory }
  205. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  206. { const already used ? }
  207. lastlabel:=nil;
  208. lastlabelhp:=nil;
  209. if not assigned(lab_str) then
  210. begin
  211. if is_shortstring(resulttype.def) then
  212. mylength:=len+2
  213. else
  214. mylength:=len+1;
  215. { widestrings can't be reused yet }
  216. if not(is_widestring(resulttype.def)) then
  217. begin
  218. { tries to found an old entry }
  219. hp1:=tai(Consts.first);
  220. while assigned(hp1) do
  221. begin
  222. if hp1.typ=ait_label then
  223. begin
  224. lastlabel:=tai_label(hp1).l;
  225. lastlabelhp:=hp1;
  226. end
  227. else
  228. begin
  229. same_string:=false;
  230. if (hp1.typ=ait_string) and
  231. (lastlabel<>nil) and
  232. (tai_string(hp1).len=mylength) then
  233. begin
  234. { if shortstring then check the length byte first and
  235. set the start index to 1 }
  236. case st_type of
  237. st_shortstring:
  238. begin
  239. if len=ord(tai_string(hp1).str[0]) then
  240. begin
  241. j:=1;
  242. same_string:=true;
  243. if len>0 then
  244. begin
  245. for i:=0 to len-1 do
  246. begin
  247. if tai_string(hp1).str[j]<>value_str[i] then
  248. begin
  249. same_string:=false;
  250. break;
  251. end;
  252. inc(j);
  253. end;
  254. end;
  255. end;
  256. end;
  257. {$ifdef ansistring_bits}
  258. st_ansistring16:
  259. begin
  260. { before the string the following sequence must be found:
  261. <label>
  262. constsymbol <datalabel>
  263. const32 <len>
  264. const32 <len>
  265. const32 -1
  266. we must then return <label> to reuse
  267. }
  268. hp2:=tai(lastlabelhp.previous);
  269. if assigned(hp2) and
  270. (hp2.typ=ait_const_16bit) and
  271. (tai_const(hp2).value=aword(-1)) and
  272. assigned(hp2.previous) and
  273. (tai(hp2.previous).typ=ait_const_16bit) and
  274. (tai_const(hp2.previous).value=len) and
  275. assigned(hp2.previous.previous) and
  276. (tai(hp2.previous.previous).typ=ait_const_16bit) and
  277. (tai_const(hp2.previous.previous).value=len) and
  278. assigned(hp2.previous.previous.previous) and
  279. (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
  280. assigned(hp2.previous.previous.previous.previous) and
  281. (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
  282. begin
  283. lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
  284. same_string:=true;
  285. j:=0;
  286. if len>0 then
  287. begin
  288. for i:=0 to len-1 do
  289. begin
  290. if tai_string(hp1).str[j]<>value_str[i] then
  291. begin
  292. same_string:=false;
  293. break;
  294. end;
  295. inc(j);
  296. end;
  297. end;
  298. end;
  299. end;
  300. {$endif}
  301. {$ifdef ansistring_bits}
  302. st_ansistring32,
  303. {$else}
  304. st_ansistring,
  305. {$endif}
  306. st_widestring :
  307. begin
  308. { before the string the following sequence must be found:
  309. <label>
  310. constsymbol <datalabel>
  311. const32 <len>
  312. const32 <len>
  313. const32 -1
  314. we must then return <label> to reuse
  315. }
  316. hp2:=tai(lastlabelhp.previous);
  317. if assigned(hp2) and
  318. (hp2.typ=ait_const_32bit) and
  319. (tai_const(hp2).value=aword(-1)) and
  320. assigned(hp2.previous) and
  321. (tai(hp2.previous).typ=ait_const_32bit) and
  322. (tai_const(hp2.previous).value=len) and
  323. assigned(hp2.previous.previous) and
  324. (tai(hp2.previous.previous).typ=ait_const_32bit) and
  325. (tai_const(hp2.previous.previous).value=len) and
  326. assigned(hp2.previous.previous.previous) and
  327. (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
  328. assigned(hp2.previous.previous.previous.previous) and
  329. (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
  330. begin
  331. lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
  332. same_string:=true;
  333. j:=0;
  334. if len>0 then
  335. begin
  336. for i:=0 to len-1 do
  337. begin
  338. if tai_string(hp1).str[j]<>value_str[i] then
  339. begin
  340. same_string:=false;
  341. break;
  342. end;
  343. inc(j);
  344. end;
  345. end;
  346. end;
  347. end;
  348. {$ifdef ansistring_bits}
  349. st_ansistring64:
  350. begin
  351. { before the string the following sequence must be found:
  352. <label>
  353. constsymbol <datalabel>
  354. const32 <len>
  355. const32 <len>
  356. const32 -1
  357. we must then return <label> to reuse
  358. }
  359. hp2:=tai(lastlabelhp.previous);
  360. if assigned(hp2) and
  361. (hp2.typ=ait_const_64bit) and
  362. (tai_const(hp2).value=aword(-1)) and
  363. assigned(hp2.previous) and
  364. (tai(hp2.previous).typ=ait_const_64bit) and
  365. (tai_const(hp2.previous).value=len) and
  366. assigned(hp2.previous.previous) and
  367. (tai(hp2.previous.previous).typ=ait_const_64bit) and
  368. (tai_const(hp2.previous.previous).value=len) and
  369. assigned(hp2.previous.previous.previous) and
  370. (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
  371. assigned(hp2.previous.previous.previous.previous) and
  372. (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
  373. begin
  374. lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
  375. same_string:=true;
  376. j:=0;
  377. if len>0 then
  378. begin
  379. for i:=0 to len-1 do
  380. begin
  381. if tai_string(hp1).str[j]<>value_str[i] then
  382. begin
  383. same_string:=false;
  384. break;
  385. end;
  386. inc(j);
  387. end;
  388. end;
  389. end;
  390. end;
  391. {$endif}
  392. end;
  393. { found ? }
  394. if same_string then
  395. begin
  396. lab_str:=lastlabel;
  397. break;
  398. end;
  399. end;
  400. lastlabel:=nil;
  401. end;
  402. hp1:=tai(hp1.next);
  403. end;
  404. end;
  405. { :-(, we must generate a new entry }
  406. if not assigned(lab_str) then
  407. begin
  408. objectlibrary.getdatalabel(lastlabel);
  409. lab_str:=lastlabel;
  410. if (cs_create_smart in aktmoduleswitches) then
  411. Consts.concat(Tai_cut.Create);
  412. consts.concat(tai_align.create(const_align(4)));
  413. Consts.concat(Tai_label.Create(lastlabel));
  414. { generate an ansi string ? }
  415. case st_type of
  416. {$ifdef ansistring_bits}
  417. st_ansistring16:
  418. begin
  419. { an empty ansi string is nil! }
  420. if len=0 then
  421. Consts.concat(Tai_const.Create_ptr(0))
  422. else
  423. begin
  424. objectlibrary.getdatalabel(l1);
  425. objectlibrary.getdatalabel(l2);
  426. Consts.concat(Tai_label.Create(l2));
  427. Consts.concat(Tai_const_symbol.Create(l1));
  428. Consts.concat(Tai_const.Create_32bit(len));
  429. Consts.concat(Tai_const.Create_32bit(len));
  430. Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
  431. Consts.concat(Tai_label.Create(l1));
  432. getmem(pc,len+2);
  433. move(value_str^,pc^,len);
  434. pc[len]:=#0;
  435. { to overcome this problem we set the length explicitly }
  436. { with the ending null char }
  437. Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
  438. { return the offset of the real string }
  439. lab_str:=l2;
  440. end;
  441. end;
  442. {$endif}
  443. {$ifdef ansistring_bits}st_ansistring32:{$else}st_ansistring:{$endif}
  444. begin
  445. { an empty ansi string is nil! }
  446. if len=0 then
  447. Consts.concat(Tai_const.Create_ptr(0))
  448. else
  449. begin
  450. objectlibrary.getdatalabel(l1);
  451. objectlibrary.getdatalabel(l2);
  452. Consts.concat(Tai_label.Create(l2));
  453. Consts.concat(Tai_const_symbol.Create(l1));
  454. Consts.concat(Tai_const.Create_32bit(len));
  455. Consts.concat(Tai_const.Create_32bit(len));
  456. Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
  457. Consts.concat(Tai_label.Create(l1));
  458. getmem(pc,len+2);
  459. move(value_str^,pc^,len);
  460. pc[len]:=#0;
  461. { to overcome this problem we set the length explicitly }
  462. { with the ending null char }
  463. Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
  464. { return the offset of the real string }
  465. lab_str:=l2;
  466. end;
  467. end;
  468. {$ifdef ansistring_bits}
  469. st_ansistring64:
  470. begin
  471. { an empty ansi string is nil! }
  472. if len=0 then
  473. Consts.concat(Tai_const.Create_ptr(0))
  474. else
  475. begin
  476. objectlibrary.getdatalabel(l1);
  477. objectlibrary.getdatalabel(l2);
  478. Consts.concat(Tai_label.Create(l2));
  479. Consts.concat(Tai_const_symbol.Create(l1));
  480. Consts.concat(Tai_const.Create_32bit(len));
  481. Consts.concat(Tai_const.Create_32bit(len));
  482. Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
  483. Consts.concat(Tai_label.Create(l1));
  484. getmem(pc,len+2);
  485. move(value_str^,pc^,len);
  486. pc[len]:=#0;
  487. { to overcome this problem we set the length explicitly }
  488. { with the ending null char }
  489. Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
  490. { return the offset of the real string }
  491. lab_str:=l2;
  492. end;
  493. end;
  494. {$endif}
  495. st_widestring:
  496. begin
  497. { an empty wide string is nil! }
  498. if len=0 then
  499. Consts.concat(Tai_const.Create_ptr(0))
  500. else
  501. begin
  502. objectlibrary.getdatalabel(l1);
  503. objectlibrary.getdatalabel(l2);
  504. Consts.concat(Tai_label.Create(l2));
  505. Consts.concat(Tai_const_symbol.Create(l1));
  506. { we use always UTF-16 coding for constants }
  507. { at least for now }
  508. { Consts.concat(Tai_const.Create_8bit(2)); }
  509. Consts.concat(Tai_const.Create_32bit(len));
  510. Consts.concat(Tai_const.Create_32bit(len));
  511. Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
  512. Consts.concat(Tai_label.Create(l1));
  513. for i:=0 to len-1 do
  514. Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));
  515. { terminating zero }
  516. Consts.concat(Tai_const.Create_16bit(0));
  517. { return the offset of the real string }
  518. lab_str:=l2;
  519. end;
  520. end;
  521. st_shortstring:
  522. begin
  523. { truncate strings larger than 255 chars }
  524. if len>255 then
  525. l:=255
  526. else
  527. l:=len;
  528. { also length and terminating zero }
  529. getmem(pc,l+3);
  530. move(value_str^,pc[1],l+1);
  531. pc[0]:=chr(l);
  532. { to overcome this problem we set the length explicitly }
  533. { with the ending null char }
  534. pc[l+1]:=#0;
  535. Consts.concat(Tai_string.Create_length_pchar(pc,l+2));
  536. end;
  537. end;
  538. end;
  539. end;
  540. location.reference.symbol:=lab_str;
  541. end;
  542. {*****************************************************************************
  543. TCGSETCONSTNODE
  544. *****************************************************************************}
  545. procedure tcgsetconstnode.pass_2;
  546. var
  547. hp1 : tai;
  548. lastlabel : tasmlabel;
  549. i : longint;
  550. neededtyp : taitype;
  551. indexadjust : longint;
  552. type
  553. setbytes=array[0..31] of byte;
  554. Psetbytes=^setbytes;
  555. begin
  556. { xor indexadjust with indexes in a set typecasted to an array of }
  557. { bytes to get the correct locations, also when endianess of source }
  558. { and destiantion differs (JM) }
  559. if (source_info.endian = target_info.endian) then
  560. indexadjust := 0
  561. else
  562. indexadjust := 3;
  563. { small sets are loaded as constants }
  564. if tsetdef(resulttype.def).settype=smallset then
  565. begin
  566. location_reset(location,LOC_CONSTANT,OS_32);
  567. location.value:=PAWord(value_set)^;
  568. exit;
  569. end;
  570. location_reset(location,LOC_CREFERENCE,OS_NO);
  571. neededtyp:=ait_const_8bit;
  572. lastlabel:=nil;
  573. { const already used ? }
  574. if not assigned(lab_set) then
  575. begin
  576. { tries to found an old entry }
  577. hp1:=tai(Consts.first);
  578. while assigned(hp1) do
  579. begin
  580. if hp1.typ=ait_label then
  581. lastlabel:=tai_label(hp1).l
  582. else
  583. begin
  584. if (lastlabel<>nil) and (hp1.typ=neededtyp) then
  585. begin
  586. if (hp1.typ=ait_const_8bit) then
  587. begin
  588. { compare normal set }
  589. i:=0;
  590. while assigned(hp1) and (i<32) do
  591. begin
  592. if tai_const(hp1).value<>Psetbytes(value_set)^[i xor indexadjust] then
  593. break;
  594. inc(i);
  595. hp1:=tai(hp1.next);
  596. end;
  597. if i=32 then
  598. begin
  599. { found! }
  600. lab_set:=lastlabel;
  601. break;
  602. end;
  603. { leave when the end of consts is reached, so no
  604. hp1.next is done }
  605. if not assigned(hp1) then
  606. break;
  607. end
  608. else
  609. begin
  610. { compare small set }
  611. if paword(value_set)^=tai_const(hp1).value then
  612. begin
  613. { found! }
  614. lab_set:=lastlabel;
  615. break;
  616. end;
  617. end;
  618. end;
  619. lastlabel:=nil;
  620. end;
  621. hp1:=tai(hp1.next);
  622. end;
  623. { :-(, we must generate a new entry }
  624. if not assigned(lab_set) then
  625. begin
  626. objectlibrary.getdatalabel(lastlabel);
  627. lab_set:=lastlabel;
  628. if (cs_create_smart in aktmoduleswitches) then
  629. Consts.concat(Tai_cut.Create);
  630. consts.concat(tai_align.create(const_align(4)));
  631. Consts.concat(Tai_label.Create(lastlabel));
  632. { already handled at the start of this method?? (JM)
  633. if tsetdef(resulttype.def).settype=smallset then
  634. begin
  635. move(value_set^,i,sizeof(longint));
  636. Consts.concat(Tai_const.Create_32bit(i));
  637. end
  638. else
  639. }
  640. begin
  641. for i:=0 to 31 do
  642. Consts.concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i xor indexadjust]));
  643. end;
  644. end;
  645. end;
  646. location.reference.symbol:=lab_set;
  647. end;
  648. {*****************************************************************************
  649. TCGNILNODE
  650. *****************************************************************************}
  651. procedure tcgnilnode.pass_2;
  652. begin
  653. location_reset(location,LOC_CONSTANT,OS_ADDR);
  654. location.value:=0;
  655. end;
  656. {*****************************************************************************
  657. TCGPOINTERCONSTNODE
  658. *****************************************************************************}
  659. procedure tcgguidconstnode.pass_2;
  660. var
  661. tmplabel : TAsmLabel;
  662. i : integer;
  663. begin
  664. location_reset(location,LOC_CREFERENCE,OS_NO);
  665. { label for GUID }
  666. objectlibrary.getdatalabel(tmplabel);
  667. consts.concat(tai_align.create(const_align(16)));
  668. consts.concat(Tai_label.Create(tmplabel));
  669. consts.concat(Tai_const.Create_32bit(value.D1));
  670. consts.concat(Tai_const.Create_16bit(value.D2));
  671. consts.concat(Tai_const.Create_16bit(value.D3));
  672. for i:=Low(value.D4) to High(value.D4) do
  673. consts.concat(Tai_const.Create_8bit(value.D4[i]));
  674. location.reference.symbol:=tmplabel;
  675. end;
  676. begin
  677. crealconstnode:=tcgrealconstnode;
  678. cordconstnode:=tcgordconstnode;
  679. cpointerconstnode:=tcgpointerconstnode;
  680. cstringconstnode:=tcgstringconstnode;
  681. csetconstnode:=tcgsetconstnode;
  682. cnilnode:=tcgnilnode;
  683. cguidconstnode:=tcgguidconstnode;
  684. end.
  685. {
  686. $Log$
  687. Revision 1.40 2004-04-29 19:56:37 daniel
  688. * Prepare compiler infrastructure for multiple ansistring types
  689. Revision 1.39 2004/03/18 17:29:40 peter
  690. * fix overflow
  691. Revision 1.38 2004/03/16 16:19:44 peter
  692. * fix out of bounds for string compares
  693. Revision 1.37 2004/02/26 16:16:38 peter
  694. * tai_const.create_ptr added
  695. Revision 1.36 2004/01/24 18:12:40 florian
  696. * fixed several arm floating point issues
  697. Revision 1.35 2004/01/12 16:39:40 peter
  698. * sparc updates, mostly float related
  699. Revision 1.34 2003/12/08 22:34:24 peter
  700. * tai_const.create_32bit changed to cardinal
  701. Revision 1.33 2003/10/26 13:37:22 florian
  702. * fixed web bug 2128
  703. Revision 1.32 2003/10/10 17:48:13 peter
  704. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  705. * tregisteralloctor renamed to trgobj
  706. * removed rgobj from a lot of units
  707. * moved location_* and reference_* to cgobj
  708. * first things for mmx register allocation
  709. Revision 1.31 2003/10/01 20:34:48 peter
  710. * procinfo unit contains tprocinfo
  711. * cginfo renamed to cgbase
  712. * moved cgmessage to verbose
  713. * fixed ppc and sparc compiles
  714. Revision 1.30 2003/09/06 16:47:24 florian
  715. + support of NaN and Inf in the compiler as values of real constants
  716. Revision 1.29 2003/09/03 15:55:00 peter
  717. * NEWRA branch merged
  718. Revision 1.28 2003/05/01 12:24:22 jonas
  719. * fixed endian issues when writing out set constants
  720. Revision 1.27 2003/04/24 22:29:57 florian
  721. * fixed a lot of PowerPC related stuff
  722. Revision 1.26 2003/01/05 13:36:53 florian
  723. * x86-64 compiles
  724. + very basic support for float128 type (x86-64 only)
  725. Revision 1.25 2002/12/29 16:58:11 peter
  726. * write terminating 0 for widestring constants
  727. Revision 1.24 2002/12/07 14:10:21 carl
  728. * fix warnings by adding explicit typecasts
  729. Revision 1.23 2002/11/25 17:43:17 peter
  730. * splitted defbase in defutil,symutil,defcmp
  731. * merged isconvertable and is_equal into compare_defs(_ext)
  732. * made operator search faster by walking the list only once
  733. Revision 1.22 2002/11/09 15:36:50 carl
  734. * align all constants correctly (default of 4 size for real type constants)
  735. Revision 1.21 2002/10/06 21:01:50 peter
  736. * use tconstexpruint instead of qword
  737. Revision 1.20 2002/10/05 12:43:25 carl
  738. * fixes for Delphi 6 compilation
  739. (warning : Some features do not work under Delphi)
  740. Revision 1.19 2002/08/18 20:06:23 peter
  741. * inlining is now also allowed in interface
  742. * renamed write/load to ppuwrite/ppuload
  743. * tnode storing in ppu
  744. * nld,ncon,nbas are already updated for storing in ppu
  745. Revision 1.18 2002/08/11 14:32:26 peter
  746. * renamed current_library to objectlibrary
  747. Revision 1.17 2002/08/11 13:24:11 peter
  748. * saving of asmsymbols in ppu supported
  749. * asmsymbollist global is removed and moved into a new class
  750. tasmlibrarydata that will hold the info of a .a file which
  751. corresponds with a single module. Added librarydata to tmodule
  752. to keep the library info stored for the module. In the future the
  753. objectfiles will also be stored to the tasmlibrarydata class
  754. * all getlabel/newasmsymbol and friends are moved to the new class
  755. Revision 1.16 2002/08/10 17:15:06 jonas
  756. * endianess fix
  757. Revision 1.15 2002/07/23 12:34:30 daniel
  758. * Readded old set code. To use it define 'oldset'. Activated by default
  759. for ppc.
  760. Revision 1.14 2002/07/22 11:48:04 daniel
  761. * Sets are now internally sets.
  762. Revision 1.13 2002/07/20 11:57:53 florian
  763. * types.pas renamed to defbase.pas because D6 contains a types
  764. unit so this would conflicts if D6 programms are compiled
  765. + Willamette/SSE2 instructions to assembler added
  766. Revision 1.12 2002/07/01 18:46:22 peter
  767. * internal linker
  768. * reorganized aasm layer
  769. Revision 1.11 2002/07/01 16:23:53 peter
  770. * cg64 patch
  771. * basics for currency
  772. * asnode updates for class and interface (not finished)
  773. Revision 1.10 2002/05/18 13:34:09 peter
  774. * readded missing revisions
  775. Revision 1.9 2002/05/16 19:46:37 carl
  776. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  777. + try to fix temp allocation (still in ifdef)
  778. + generic constructor calls
  779. + start of tassembler / tmodulebase class cleanup
  780. Revision 1.7 2002/04/04 19:05:57 peter
  781. * removed unused units
  782. * use tlocation.size in cg.a_*loc*() routines
  783. Revision 1.6 2002/04/02 17:11:28 peter
  784. * tlocation,treference update
  785. * LOC_CONSTANT added for better constant handling
  786. * secondadd splitted in multiple routines
  787. * location_force_reg added for loading a location to a register
  788. of a specified size
  789. * secondassignment parses now first the right and then the left node
  790. (this is compatible with Kylix). This saves a lot of push/pop especially
  791. with string operations
  792. * adapted some routines to use the new cg methods
  793. Revision 1.5 2002/03/31 20:26:34 jonas
  794. + a_loadfpu_* and a_loadmm_* methods in tcg
  795. * register allocation is now handled by a class and is mostly processor
  796. independent (+rgobj.pas and i386/rgcpu.pas)
  797. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  798. * some small improvements and fixes to the optimizer
  799. * some register allocation fixes
  800. * some fpuvaroffset fixes in the unary minus node
  801. * push/popusedregisters is now called rg.save/restoreusedregisters and
  802. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  803. also better optimizable)
  804. * fixed and optimized register saving/restoring for new/dispose nodes
  805. * LOC_FPU locations now also require their "register" field to be set to
  806. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  807. - list field removed of the tnode class because it's not used currently
  808. and can cause hard-to-find bugs
  809. Revision 1.4 2002/02/26 09:12:39 jonas
  810. * fixed problem when compiling the compiler with Delphi (reported by
  811. "Luc Langlois" <[email protected]>) (lo/hi don't work as in FPC
  812. when used with int64's under Delphi)
  813. }