nmat.pas 31 KB

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