ncgcon.pas 40 KB

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