nmat.pas 30 KB

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