nmat.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964
  1. {
  2. Copyright (c) 2000-2005 by Florian Klaempfl
  3. Type checking and register allocation for math nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nmat;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node;
  22. type
  23. tmoddivnode = class(tbinopnode)
  24. function pass_1 : tnode;override;
  25. function det_resulttype:tnode;override;
  26. function simplify : tnode;override;
  27. protected
  28. {$ifndef cpu64bit}
  29. { override the following if you want to implement }
  30. { parts explicitely in the code generator (JM) }
  31. function first_moddiv64bitint: tnode; virtual;
  32. {$endif cpu64bit}
  33. function firstoptimize: tnode; virtual;
  34. function first_moddivint: tnode; virtual;
  35. end;
  36. tmoddivnodeclass = class of tmoddivnode;
  37. tshlshrnode = class(tbinopnode)
  38. function pass_1 : tnode;override;
  39. function det_resulttype:tnode;override;
  40. function simplify : tnode;override;
  41. {$ifndef cpu64bit}
  42. { override the following if you want to implement }
  43. { parts explicitely in the code generator (CEC)
  44. Should return nil, if everything will be handled
  45. in the code generator
  46. }
  47. function first_shlshr64bitint: tnode; virtual;
  48. {$endif cpu64bit}
  49. end;
  50. tshlshrnodeclass = class of tshlshrnode;
  51. tunaryminusnode = class(tunarynode)
  52. constructor create(expr : tnode);virtual;
  53. function pass_1 : tnode;override;
  54. function det_resulttype:tnode;override;
  55. function simplify : tnode;override;
  56. end;
  57. tunaryminusnodeclass = class of tunaryminusnode;
  58. tnotnode = class(tunarynode)
  59. constructor create(expr : tnode);virtual;
  60. function pass_1 : tnode;override;
  61. function det_resulttype:tnode;override;
  62. function simplify : tnode;override;
  63. {$ifdef state_tracking}
  64. function track_state_pass(exec_known:boolean):boolean;override;
  65. {$endif}
  66. end;
  67. tnotnodeclass = class of tnotnode;
  68. var
  69. cmoddivnode : tmoddivnodeclass;
  70. cshlshrnode : tshlshrnodeclass;
  71. cunaryminusnode : tunaryminusnodeclass;
  72. cnotnode : tnotnodeclass;
  73. implementation
  74. uses
  75. systems,
  76. verbose,globals,cutils,
  77. globtype,
  78. symconst,symtype,symdef,defutil,
  79. htypechk,pass_1,
  80. cgbase,
  81. ncon,ncnv,ncal,nadd;
  82. {****************************************************************************
  83. TMODDIVNODE
  84. ****************************************************************************}
  85. function tmoddivnode.simplify:tnode;
  86. var
  87. t : tnode;
  88. rd,ld : torddef;
  89. rv,lv : tconstexprint;
  90. begin
  91. result:=nil;
  92. if is_constintnode(right) then
  93. begin
  94. if tordconstnode(right).value = 1 then
  95. begin
  96. case nodetype of
  97. modn:
  98. result := cordconstnode.create(0,left.resulttype,true);
  99. divn:
  100. result := left.getcopy;
  101. end;
  102. exit;
  103. end;
  104. end;
  105. if is_constintnode(right) and is_constintnode(left) then
  106. begin
  107. rd:=torddef(right.resulttype.def);
  108. ld:=torddef(left.resulttype.def);
  109. rv:=tordconstnode(right).value;
  110. lv:=tordconstnode(left).value;
  111. case nodetype of
  112. modn:
  113. if (torddef(ld).typ <> u64bit) or
  114. (torddef(rd).typ <> u64bit) then
  115. t:=genintconstnode(lv mod rv)
  116. else
  117. t:=genintconstnode(int64(qword(lv) mod qword(rv)));
  118. divn:
  119. if (torddef(ld).typ <> u64bit) or
  120. (torddef(rd).typ <> u64bit) then
  121. t:=genintconstnode(lv div rv)
  122. else
  123. t:=genintconstnode(int64(qword(lv) div qword(rv)));
  124. end;
  125. result:=t;
  126. exit;
  127. end;
  128. end;
  129. function tmoddivnode.det_resulttype:tnode;
  130. var
  131. hp,t : tnode;
  132. rd,ld : torddef;
  133. rv : tconstexprint;
  134. begin
  135. result:=nil;
  136. resulttypepass(left);
  137. resulttypepass(right);
  138. set_varstate(left,vs_read,[vsf_must_be_valid]);
  139. set_varstate(right,vs_read,[vsf_must_be_valid]);
  140. if codegenerror then
  141. exit;
  142. result:=simplify;
  143. if assigned(result) then
  144. exit;
  145. { allow operator overloading }
  146. t:=self;
  147. if isbinaryoverloaded(t) then
  148. begin
  149. result:=t;
  150. exit;
  151. end;
  152. { we need 2 orddefs always }
  153. if (left.resulttype.def.deftype<>orddef) then
  154. inserttypeconv(right,sinttype);
  155. if (right.resulttype.def.deftype<>orddef) then
  156. inserttypeconv(right,sinttype);
  157. if codegenerror then
  158. exit;
  159. rd:=torddef(right.resulttype.def);
  160. ld:=torddef(left.resulttype.def);
  161. { check for division by zero }
  162. if is_constintnode(right) then
  163. begin
  164. rv:=tordconstnode(right).value;
  165. if (rv=0) then
  166. begin
  167. Message(parser_e_division_by_zero);
  168. { recover }
  169. rv:=1;
  170. end;
  171. end;
  172. { if one operand is a cardinal and the other is a positive constant, convert the }
  173. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  174. { Do the same for qwords and positive constants as well, otherwise things like }
  175. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  176. { "qword" was > high(int64) (JM) }
  177. if (rd.typ in [u32bit,u64bit]) and
  178. is_constintnode(left) and
  179. (tordconstnode(left).value >= 0) then
  180. begin
  181. inserttypeconv(left,right.resulttype);
  182. ld:=torddef(left.resulttype.def);
  183. end;
  184. if (ld.typ in [u32bit,u64bit]) and
  185. is_constintnode(right) and
  186. (tordconstnode(right).value >= 0) then
  187. begin
  188. inserttypeconv(right,left.resulttype);
  189. rd:=torddef(right.resulttype.def);
  190. end;
  191. { when there is one currency value, everything is done
  192. using currency }
  193. if (ld.typ=scurrency) or
  194. (rd.typ=scurrency) then
  195. begin
  196. if (ld.typ<>scurrency) then
  197. inserttypeconv(left,s64currencytype);
  198. if (rd.typ<>scurrency) then
  199. inserttypeconv(right,s64currencytype);
  200. resulttype:=left.resulttype;
  201. end
  202. else
  203. {$ifndef cpu64bit}
  204. { when there is one 64bit value, everything is done
  205. in 64bit }
  206. if (is_64bitint(left.resulttype.def) or
  207. is_64bitint(right.resulttype.def)) then
  208. begin
  209. if is_signed(rd) or is_signed(ld) then
  210. begin
  211. if (ld.typ<>s64bit) then
  212. inserttypeconv(left,s64inttype);
  213. if (rd.typ<>s64bit) then
  214. inserttypeconv(right,s64inttype);
  215. end
  216. else
  217. begin
  218. if (ld.typ<>u64bit) then
  219. inserttypeconv(left,u64inttype);
  220. if (rd.typ<>u64bit) then
  221. inserttypeconv(right,u64inttype);
  222. end;
  223. resulttype:=left.resulttype;
  224. end
  225. else
  226. { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
  227. if ((rd.typ = u32bit) and
  228. is_signed(ld)) or
  229. ((ld.typ = u32bit) and
  230. is_signed(rd)) then
  231. begin
  232. CGMessage(type_w_mixed_signed_unsigned);
  233. if (ld.typ<>s64bit) then
  234. inserttypeconv(left,s64inttype);
  235. if (rd.typ<>s64bit) then
  236. inserttypeconv(right,s64inttype);
  237. resulttype:=left.resulttype;
  238. end
  239. else
  240. {$endif cpu64bit}
  241. begin
  242. { Make everything always default singed int }
  243. if not(rd.typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  244. inserttypeconv(right,sinttype);
  245. if not(ld.typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  246. inserttypeconv(left,sinttype);
  247. resulttype:=right.resulttype;
  248. end;
  249. { when the result is currency we need some extra code for
  250. division. this should not be done when the divn node is
  251. created internally }
  252. if (nodetype=divn) and
  253. not(nf_is_currency in flags) and
  254. is_currency(resulttype.def) then
  255. begin
  256. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  257. include(hp.flags,nf_is_currency);
  258. result:=hp;
  259. end;
  260. end;
  261. function tmoddivnode.first_moddivint: tnode;
  262. {$ifdef cpuneedsdiv32helper}
  263. var
  264. procname: string[31];
  265. begin
  266. result := nil;
  267. { otherwise create a call to a helper }
  268. if nodetype = divn then
  269. procname := 'fpc_div_'
  270. else
  271. procname := 'fpc_mod_';
  272. { only qword needs the unsigned code, the
  273. signed code is also used for currency }
  274. if is_signed(resulttype.def) then
  275. procname := procname + 'longint'
  276. else
  277. procname := procname + 'dword';
  278. result := ccallnode.createintern(procname,ccallparanode.create(left,
  279. ccallparanode.create(right,nil)));
  280. left := nil;
  281. right := nil;
  282. firstpass(result);
  283. end;
  284. {$else cpuneedsdiv32helper}
  285. begin
  286. result:=nil;
  287. end;
  288. {$endif cpuneedsdiv32helper}
  289. {$ifndef cpu64bit}
  290. function tmoddivnode.first_moddiv64bitint: tnode;
  291. var
  292. procname: string[31];
  293. begin
  294. result := nil;
  295. { when currency is used set the result of the
  296. parameters to s64bit, so they are not converted }
  297. if is_currency(resulttype.def) then
  298. begin
  299. left.resulttype:=s64inttype;
  300. right.resulttype:=s64inttype;
  301. end;
  302. { otherwise create a call to a helper }
  303. if nodetype = divn then
  304. procname := 'fpc_div_'
  305. else
  306. procname := 'fpc_mod_';
  307. { only qword needs the unsigned code, the
  308. signed code is also used for currency }
  309. if is_signed(resulttype.def) then
  310. procname := procname + 'int64'
  311. else
  312. procname := procname + 'qword';
  313. result := ccallnode.createintern(procname,ccallparanode.create(left,
  314. ccallparanode.create(right,nil)));
  315. left := nil;
  316. right := nil;
  317. firstpass(result);
  318. end;
  319. {$endif cpu64bit}
  320. function tmoddivnode.firstoptimize: tnode;
  321. var
  322. power{,shiftval} : longint;
  323. newtype: tnodetype;
  324. begin
  325. result := nil;
  326. { divide/mod a number by a constant which is a power of 2? }
  327. if (cs_opt_peephole in aktoptimizerswitches) and
  328. (right.nodetype = ordconstn) and
  329. { ((nodetype = divn) or
  330. not is_signed(resulttype.def)) and}
  331. (not is_signed(resulttype.def)) and
  332. ispowerof2(tordconstnode(right).value,power) then
  333. begin
  334. if nodetype = divn then
  335. begin
  336. (*
  337. if is_signed(resulttype.def) then
  338. begin
  339. if is_64bitint(left.resulttype.def) then
  340. if not (cs_opt_size in aktoptimizerswitches) then
  341. shiftval := 63
  342. else
  343. { the shift code is a lot bigger than the call to }
  344. { the divide helper }
  345. exit
  346. else
  347. shiftval := 31;
  348. { we reuse left twice, so create once a copy of it }
  349. { !!! if left is a call is -> call gets executed twice }
  350. left := caddnode.create(addn,left,
  351. caddnode.create(andn,
  352. cshlshrnode.create(sarn,left.getcopy,
  353. cordconstnode.create(shiftval,sinttype,false)),
  354. cordconstnode.create(tordconstnode(right).value-1,
  355. right.resulttype,false)));
  356. newtype := sarn;
  357. end
  358. else
  359. *)
  360. newtype := shrn;
  361. tordconstnode(right).value := power;
  362. result := cshlshrnode.create(newtype,left,right)
  363. end
  364. else
  365. begin
  366. dec(tordconstnode(right).value);
  367. result := caddnode.create(andn,left,right);
  368. end;
  369. { left and right are reused }
  370. left := nil;
  371. right := nil;
  372. firstpass(result);
  373. exit;
  374. end;
  375. end;
  376. function tmoddivnode.pass_1 : tnode;
  377. begin
  378. result:=nil;
  379. firstpass(left);
  380. firstpass(right);
  381. if codegenerror then
  382. exit;
  383. { Try to optimize mod/div }
  384. result := firstoptimize;
  385. if assigned(result) then
  386. exit;
  387. {$ifndef cpu64bit}
  388. { 64bit }
  389. if (left.resulttype.def.deftype=orddef) and
  390. (right.resulttype.def.deftype=orddef) and
  391. (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
  392. begin
  393. result := first_moddiv64bitint;
  394. if assigned(result) then
  395. exit;
  396. expectloc:=LOC_REGISTER;
  397. calcregisters(self,2,0,0);
  398. end
  399. else
  400. {$endif cpu64bit}
  401. begin
  402. result := first_moddivint;
  403. if assigned(result) then
  404. exit;
  405. left_right_max;
  406. if left.registersint<=right.registersint then
  407. inc(registersint);
  408. end;
  409. expectloc:=LOC_REGISTER;
  410. end;
  411. {****************************************************************************
  412. TSHLSHRNODE
  413. ****************************************************************************}
  414. function tshlshrnode.simplify:tnode;
  415. var
  416. t : tnode;
  417. begin
  418. result:=nil;
  419. { constant folding }
  420. if is_constintnode(left) and is_constintnode(right) then
  421. begin
  422. case nodetype of
  423. shrn:
  424. t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
  425. shln:
  426. t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
  427. end;
  428. result:=t;
  429. exit;
  430. end;
  431. end;
  432. function tshlshrnode.det_resulttype:tnode;
  433. var
  434. t : tnode;
  435. begin
  436. result:=nil;
  437. resulttypepass(left);
  438. resulttypepass(right);
  439. set_varstate(right,vs_read,[vsf_must_be_valid]);
  440. set_varstate(left,vs_read,[vsf_must_be_valid]);
  441. if codegenerror then
  442. exit;
  443. result:=simplify;
  444. if assigned(result) then
  445. exit;
  446. { allow operator overloading }
  447. t:=self;
  448. if isbinaryoverloaded(t) then
  449. begin
  450. result:=t;
  451. exit;
  452. end;
  453. { calculations for ordinals < 32 bit have to be done in
  454. 32 bit for backwards compatibility. That way 'shl 33' is
  455. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  456. if (not is_64bit(left.resulttype.def)) and
  457. (torddef(left.resulttype.def).typ<>u32bit) then
  458. inserttypeconv(left,s32inttype);
  459. inserttypeconv(right,sinttype);
  460. resulttype:=left.resulttype;
  461. end;
  462. {$ifndef cpu64bit}
  463. function tshlshrnode.first_shlshr64bitint: tnode;
  464. var
  465. procname: string[31];
  466. begin
  467. result := nil;
  468. { otherwise create a call to a helper }
  469. if nodetype = shln then
  470. procname := 'fpc_shl_int64'
  471. else
  472. procname := 'fpc_shr_int64';
  473. { this order of parameters works at least for the arm,
  474. however it should work for any calling conventions (FK) }
  475. result := ccallnode.createintern(procname,ccallparanode.create(right,
  476. ccallparanode.create(left,nil)));
  477. left := nil;
  478. right := nil;
  479. firstpass(result);
  480. end;
  481. {$endif cpu64bit}
  482. function tshlshrnode.pass_1 : tnode;
  483. var
  484. regs : longint;
  485. begin
  486. result:=nil;
  487. firstpass(left);
  488. firstpass(right);
  489. if codegenerror then
  490. exit;
  491. {$ifndef cpu64bit}
  492. { 64 bit ints have their own shift handling }
  493. if is_64bit(left.resulttype.def) then
  494. begin
  495. result := first_shlshr64bitint;
  496. if assigned(result) then
  497. exit;
  498. regs:=2;
  499. end
  500. else
  501. {$endif cpu64bit}
  502. begin
  503. regs:=1
  504. end;
  505. if (right.nodetype<>ordconstn) then
  506. inc(regs);
  507. expectloc:=LOC_REGISTER;
  508. calcregisters(self,regs,0,0);
  509. end;
  510. {****************************************************************************
  511. TUNARYMINUSNODE
  512. ****************************************************************************}
  513. constructor tunaryminusnode.create(expr : tnode);
  514. begin
  515. inherited create(unaryminusn,expr);
  516. end;
  517. function tunaryminusnode.simplify:tnode;
  518. begin
  519. result:=nil;
  520. { constant folding }
  521. if is_constintnode(left) then
  522. begin
  523. result:=genintconstnode(-tordconstnode(left).value);
  524. exit;
  525. end;
  526. if is_constrealnode(left) then
  527. begin
  528. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  529. result:=left;
  530. left:=nil;
  531. exit;
  532. end;
  533. end;
  534. function tunaryminusnode.det_resulttype : tnode;
  535. var
  536. t : tnode;
  537. begin
  538. result:=nil;
  539. resulttypepass(left);
  540. set_varstate(left,vs_read,[vsf_must_be_valid]);
  541. if codegenerror then
  542. exit;
  543. result:=simplify;
  544. if assigned(result) then
  545. exit;
  546. resulttype:=left.resulttype;
  547. if (left.resulttype.def.deftype=floatdef) then
  548. begin
  549. end
  550. {$ifdef SUPPORT_MMX}
  551. else if (cs_mmx in aktlocalswitches) and
  552. is_mmx_able_array(left.resulttype.def) then
  553. begin
  554. { if saturation is on, left.resulttype.def isn't
  555. "mmx able" (FK)
  556. if (cs_mmx_saturation in aktlocalswitches^) and
  557. (torddef(tarraydef(resulttype.def).definition).typ in
  558. [s32bit,u32bit]) then
  559. CGMessage(type_e_mismatch);
  560. }
  561. end
  562. {$endif SUPPORT_MMX}
  563. {$ifndef cpu64bit}
  564. else if is_64bitint(left.resulttype.def) then
  565. begin
  566. end
  567. {$endif cpu64bit}
  568. else if (left.resulttype.def.deftype=orddef) then
  569. begin
  570. inserttypeconv(left,sinttype);
  571. resulttype:=left.resulttype;
  572. end
  573. else
  574. begin
  575. { allow operator overloading }
  576. t:=self;
  577. if isunaryoverloaded(t) then
  578. begin
  579. result:=t;
  580. exit;
  581. end;
  582. CGMessage(type_e_mismatch);
  583. end;
  584. end;
  585. { generic code }
  586. { overridden by: }
  587. { i386 }
  588. function tunaryminusnode.pass_1 : tnode;
  589. var
  590. procname: string[31];
  591. begin
  592. result:=nil;
  593. firstpass(left);
  594. if codegenerror then
  595. exit;
  596. if (cs_fp_emulation in aktmoduleswitches) and (left.resulttype.def.deftype=floatdef) then
  597. begin
  598. if not(target_info.system in system_wince) then
  599. begin
  600. case tfloatdef(resulttype.def).typ of
  601. s32real:
  602. procname:='float32_sub';
  603. s64real:
  604. procname:='float64_sub';
  605. {!!! not yet implemented
  606. s128real:
  607. }
  608. else
  609. internalerror(2005082801);
  610. end;
  611. result:=ccallnode.createintern(procname,ccallparanode.create(crealconstnode.create(0,resulttype),
  612. ccallparanode.create(left,nil)));
  613. end
  614. else
  615. begin
  616. case tfloatdef(resulttype.def).typ of
  617. s32real:
  618. procname:='NEGS';
  619. s64real:
  620. procname:='NEGD';
  621. {!!! not yet implemented
  622. s128real:
  623. }
  624. else
  625. internalerror(2005082802);
  626. end;
  627. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  628. end;
  629. left:=nil;
  630. end
  631. else
  632. begin
  633. registersint:=left.registersint;
  634. registersfpu:=left.registersfpu;
  635. {$ifdef SUPPORT_MMX}
  636. registersmmx:=left.registersmmx;
  637. {$endif SUPPORT_MMX}
  638. if (left.resulttype.def.deftype=floatdef) then
  639. begin
  640. if (left.expectloc<>LOC_REGISTER) and
  641. (registersfpu<1) then
  642. registersfpu:=1;
  643. expectloc:=LOC_FPUREGISTER;
  644. end
  645. {$ifdef SUPPORT_MMX}
  646. else if (cs_mmx in aktlocalswitches) and
  647. is_mmx_able_array(left.resulttype.def) then
  648. begin
  649. if (left.expectloc<>LOC_MMXREGISTER) and
  650. (registersmmx<1) then
  651. registersmmx:=1;
  652. end
  653. {$endif SUPPORT_MMX}
  654. {$ifndef cpu64bit}
  655. else if is_64bit(left.resulttype.def) then
  656. begin
  657. if (left.expectloc<>LOC_REGISTER) and
  658. (registersint<2) then
  659. registersint:=2;
  660. expectloc:=LOC_REGISTER;
  661. end
  662. {$endif cpu64bit}
  663. else if (left.resulttype.def.deftype=orddef) then
  664. begin
  665. if (left.expectloc<>LOC_REGISTER) and
  666. (registersint<1) then
  667. registersint:=1;
  668. expectloc:=LOC_REGISTER;
  669. end;
  670. end;
  671. end;
  672. {****************************************************************************
  673. TNOTNODE
  674. ****************************************************************************}
  675. const
  676. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  677. gten,gtn,lten,ltn,unequaln,equaln
  678. );
  679. constructor tnotnode.create(expr : tnode);
  680. begin
  681. inherited create(notn,expr);
  682. end;
  683. function tnotnode.simplify:tnode;
  684. var
  685. v : tconstexprint;
  686. t : tnode;
  687. tt : ttype;
  688. begin
  689. result:=nil;
  690. { Try optmimizing ourself away }
  691. if left.nodetype=notn then
  692. begin
  693. { Double not. Remove both }
  694. result:=Tnotnode(left).left;
  695. tnotnode(left).left:=nil;
  696. exit;
  697. end;
  698. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  699. begin
  700. { Not of boolean expression. Turn around the operator and remove
  701. the not. This is not allowed for sets with the gten/lten,
  702. because there is no ltn/gtn support }
  703. if (taddnode(left).left.resulttype.def.deftype<>setdef) or
  704. (left.nodetype in [equaln,unequaln]) then
  705. begin
  706. result:=left;
  707. left.nodetype:=boolean_reverse[left.nodetype];
  708. left:=nil;
  709. exit;
  710. end;
  711. end;
  712. { constant folding }
  713. if (left.nodetype=ordconstn) then
  714. begin
  715. v:=tordconstnode(left).value;
  716. tt:=left.resulttype;
  717. case torddef(left.resulttype.def).typ of
  718. bool8bit,
  719. bool16bit,
  720. bool32bit,
  721. bool64bit:
  722. begin
  723. { here we do a boolean(byte(..)) type cast because }
  724. { boolean(<int64>) is buggy in 1.00 }
  725. v:=byte(not(boolean(byte(v))));
  726. end;
  727. uchar,
  728. uwidechar,
  729. u8bit,
  730. s8bit,
  731. u16bit,
  732. s16bit,
  733. u32bit,
  734. s32bit,
  735. s64bit,
  736. u64bit :
  737. begin
  738. v:=int64(not int64(v)); { maybe qword is required }
  739. int_to_type(v,tt);
  740. end;
  741. else
  742. CGMessage(type_e_mismatch);
  743. end;
  744. t:=cordconstnode.create(v,tt,true);
  745. result:=t;
  746. exit;
  747. end;
  748. end;
  749. function tnotnode.det_resulttype : tnode;
  750. var
  751. t : tnode;
  752. begin
  753. result:=nil;
  754. resulttypepass(left);
  755. set_varstate(left,vs_read,[]);
  756. if codegenerror then
  757. exit;
  758. resulttype:=left.resulttype;
  759. result:=simplify;
  760. if assigned(result) then
  761. exit;
  762. if is_boolean(resulttype.def) then
  763. begin
  764. end
  765. else
  766. {$ifdef SUPPORT_MMX}
  767. if (cs_mmx in aktlocalswitches) and
  768. is_mmx_able_array(left.resulttype.def) then
  769. begin
  770. end
  771. else
  772. {$endif SUPPORT_MMX}
  773. {$ifndef cpu64bit}
  774. if is_64bitint(left.resulttype.def) then
  775. begin
  776. end
  777. else
  778. {$endif cpu64bit}
  779. if is_integer(left.resulttype.def) then
  780. begin
  781. end
  782. else
  783. begin
  784. { allow operator overloading }
  785. t:=self;
  786. if isunaryoverloaded(t) then
  787. begin
  788. result:=t;
  789. exit;
  790. end;
  791. CGMessage(type_e_mismatch);
  792. end;
  793. end;
  794. function tnotnode.pass_1 : tnode;
  795. begin
  796. result:=nil;
  797. firstpass(left);
  798. if codegenerror then
  799. exit;
  800. expectloc:=left.expectloc;
  801. registersint:=left.registersint;
  802. {$ifdef SUPPORT_MMX}
  803. registersmmx:=left.registersmmx;
  804. {$endif SUPPORT_MMX}
  805. if is_boolean(resulttype.def) then
  806. begin
  807. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  808. begin
  809. expectloc:=LOC_REGISTER;
  810. if (registersint<1) then
  811. registersint:=1;
  812. end;
  813. { before loading it into flags we need to load it into
  814. a register thus 1 register is need PM }
  815. {$ifdef cpuflags}
  816. if left.expectloc<>LOC_JUMP then
  817. expectloc:=LOC_FLAGS;
  818. {$endif def cpuflags}
  819. end
  820. else
  821. {$ifdef SUPPORT_MMX}
  822. if (cs_mmx in aktlocalswitches) and
  823. is_mmx_able_array(left.resulttype.def) then
  824. begin
  825. if (left.expectloc<>LOC_MMXREGISTER) and
  826. (registersmmx<1) then
  827. registersmmx:=1;
  828. end
  829. else
  830. {$endif SUPPORT_MMX}
  831. {$ifndef cpu64bit}
  832. if is_64bit(left.resulttype.def) then
  833. begin
  834. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  835. begin
  836. expectloc:=LOC_REGISTER;
  837. if (registersint<2) then
  838. registersint:=2;
  839. end;
  840. end
  841. else
  842. {$endif cpu64bit}
  843. if is_integer(left.resulttype.def) then
  844. begin
  845. if (left.expectloc<>LOC_REGISTER) and
  846. (registersint<1) then
  847. registersint:=1;
  848. expectloc:=LOC_REGISTER;
  849. end;
  850. end;
  851. {$ifdef state_tracking}
  852. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  853. begin
  854. track_state_pass:=true;
  855. if left.track_state_pass(exec_known) then
  856. begin
  857. left.resulttype.def:=nil;
  858. do_resulttypepass(left);
  859. end;
  860. end;
  861. {$endif}
  862. begin
  863. cmoddivnode:=tmoddivnode;
  864. cshlshrnode:=tshlshrnode;
  865. cunaryminusnode:=tunaryminusnode;
  866. cnotnode:=tnotnode;
  867. end.