ncgcon.pas 40 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931
  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(Cardinal(-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(Cardinal(-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.41 2004-06-16 20:07:08 florian
  690. * dwarf branch merged
  691. Revision 1.40 2004/04/29 19:56:37 daniel
  692. * Prepare compiler infrastructure for multiple ansistring types
  693. Revision 1.39.2.9 2004/06/13 10:51:16 florian
  694. * fixed several register allocator problems (sparc/arm)
  695. Revision 1.39.2.8 2004/06/12 17:01:01 florian
  696. * fixed compilation of arm compiler
  697. Revision 1.39.2.7 2004/05/01 16:02:09 peter
  698. * POINTER_SIZE replaced with sizeof(aint)
  699. * aint,aword,tconst*int moved to globtype
  700. Revision 1.39.2.6 2004/04/29 19:07:22 peter
  701. * compile fixes
  702. Revision 1.39.2.5 2004/04/27 18:18:25 peter
  703. * aword -> aint
  704. Revision 1.39.2.4 2004/04/12 19:34:45 peter
  705. * basic framework for dwarf CFI
  706. Revision 1.39.2.3 2004/04/12 14:45:11 peter
  707. * tai_const_symbol and tai_const merged
  708. Revision 1.39.2.2 2004/04/10 12:36:41 peter
  709. * fixed alignment issues
  710. Revision 1.39.2.1 2004/04/08 18:33:22 peter
  711. * rewrite of TAsmSection
  712. Revision 1.39 2004/03/18 17:29:40 peter
  713. * fix overflow
  714. Revision 1.38 2004/03/16 16:19:44 peter
  715. * fix out of bounds for string compares
  716. Revision 1.37 2004/02/26 16:16:38 peter
  717. * tai_const.create_ptr added
  718. Revision 1.36 2004/01/24 18:12:40 florian
  719. * fixed several arm floating point issues
  720. Revision 1.35 2004/01/12 16:39:40 peter
  721. * sparc updates, mostly float related
  722. Revision 1.34 2003/12/08 22:34:24 peter
  723. * tai_const.create_32bit changed to cardinal
  724. Revision 1.33 2003/10/26 13:37:22 florian
  725. * fixed web bug 2128
  726. Revision 1.32 2003/10/10 17:48:13 peter
  727. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  728. * tregisteralloctor renamed to trgobj
  729. * removed rgobj from a lot of units
  730. * moved location_* and reference_* to cgobj
  731. * first things for mmx register allocation
  732. Revision 1.31 2003/10/01 20:34:48 peter
  733. * procinfo unit contains tprocinfo
  734. * cginfo renamed to cgbase
  735. * moved cgmessage to verbose
  736. * fixed ppc and sparc compiles
  737. Revision 1.30 2003/09/06 16:47:24 florian
  738. + support of NaN and Inf in the compiler as values of real constants
  739. Revision 1.29 2003/09/03 15:55:00 peter
  740. * NEWRA branch merged
  741. Revision 1.28 2003/05/01 12:24:22 jonas
  742. * fixed endian issues when writing out set constants
  743. Revision 1.27 2003/04/24 22:29:57 florian
  744. * fixed a lot of PowerPC related stuff
  745. Revision 1.26 2003/01/05 13:36:53 florian
  746. * x86-64 compiles
  747. + very basic support for float128 type (x86-64 only)
  748. Revision 1.25 2002/12/29 16:58:11 peter
  749. * write terminating 0 for widestring constants
  750. Revision 1.24 2002/12/07 14:10:21 carl
  751. * fix warnings by adding explicit typecasts
  752. Revision 1.23 2002/11/25 17:43:17 peter
  753. * splitted defbase in defutil,symutil,defcmp
  754. * merged isconvertable and is_equal into compare_defs(_ext)
  755. * made operator search faster by walking the list only once
  756. Revision 1.22 2002/11/09 15:36:50 carl
  757. * align all constants correctly (default of 4 size for real type constants)
  758. Revision 1.21 2002/10/06 21:01:50 peter
  759. * use tconstexpruint instead of qword
  760. Revision 1.20 2002/10/05 12:43:25 carl
  761. * fixes for Delphi 6 compilation
  762. (warning : Some features do not work under Delphi)
  763. Revision 1.19 2002/08/18 20:06:23 peter
  764. * inlining is now also allowed in interface
  765. * renamed write/load to ppuwrite/ppuload
  766. * tnode storing in ppu
  767. * nld,ncon,nbas are already updated for storing in ppu
  768. Revision 1.18 2002/08/11 14:32:26 peter
  769. * renamed current_library to objectlibrary
  770. Revision 1.17 2002/08/11 13:24:11 peter
  771. * saving of asmsymbols in ppu supported
  772. * asmsymbollist global is removed and moved into a new class
  773. tasmlibrarydata that will hold the info of a .a file which
  774. corresponds with a single module. Added librarydata to tmodule
  775. to keep the library info stored for the module. In the future the
  776. objectfiles will also be stored to the tasmlibrarydata class
  777. * all getlabel/newasmsymbol and friends are moved to the new class
  778. Revision 1.16 2002/08/10 17:15:06 jonas
  779. * endianess fix
  780. Revision 1.15 2002/07/23 12:34:30 daniel
  781. * Readded old set code. To use it define 'oldset'. Activated by default
  782. for ppc.
  783. Revision 1.14 2002/07/22 11:48:04 daniel
  784. * Sets are now internally sets.
  785. Revision 1.13 2002/07/20 11:57:53 florian
  786. * types.pas renamed to defbase.pas because D6 contains a types
  787. unit so this would conflicts if D6 programms are compiled
  788. + Willamette/SSE2 instructions to assembler added
  789. Revision 1.12 2002/07/01 18:46:22 peter
  790. * internal linker
  791. * reorganized aasm layer
  792. Revision 1.11 2002/07/01 16:23:53 peter
  793. * cg64 patch
  794. * basics for currency
  795. * asnode updates for class and interface (not finished)
  796. Revision 1.10 2002/05/18 13:34:09 peter
  797. * readded missing revisions
  798. Revision 1.9 2002/05/16 19:46:37 carl
  799. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  800. + try to fix temp allocation (still in ifdef)
  801. + generic constructor calls
  802. + start of tassembler / tmodulebase class cleanup
  803. Revision 1.7 2002/04/04 19:05:57 peter
  804. * removed unused units
  805. * use tlocation.size in cg.a_*loc*() routines
  806. Revision 1.6 2002/04/02 17:11:28 peter
  807. * tlocation,treference update
  808. * LOC_CONSTANT added for better constant handling
  809. * secondadd splitted in multiple routines
  810. * location_force_reg added for loading a location to a register
  811. of a specified size
  812. * secondassignment parses now first the right and then the left node
  813. (this is compatible with Kylix). This saves a lot of push/pop especially
  814. with string operations
  815. * adapted some routines to use the new cg methods
  816. Revision 1.5 2002/03/31 20:26:34 jonas
  817. + a_loadfpu_* and a_loadmm_* methods in tcg
  818. * register allocation is now handled by a class and is mostly processor
  819. independent (+rgobj.pas and i386/rgcpu.pas)
  820. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  821. * some small improvements and fixes to the optimizer
  822. * some register allocation fixes
  823. * some fpuvaroffset fixes in the unary minus node
  824. * push/popusedregisters is now called rg.save/restoreusedregisters and
  825. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  826. also better optimizable)
  827. * fixed and optimized register saving/restoring for new/dispose nodes
  828. * LOC_FPU locations now also require their "register" field to be set to
  829. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  830. - list field removed of the tnode class because it's not used currently
  831. and can cause hard-to-find bugs
  832. Revision 1.4 2002/02/26 09:12:39 jonas
  833. * fixed problem when compiling the compiler with Delphi (reported by
  834. "Luc Langlois" <[email protected]>) (lo/hi don't work as in FPC
  835. when used with int64's under Delphi)
  836. }