nmat.pas 29 KB

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