nmat.pas 29 KB

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