nmat.pas 30 KB

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