nmat.pas 29 KB

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