nmat.pas 32 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Type checking and register allocation for math nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit nmat;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node;
  23. type
  24. tmoddivnode = class(tbinopnode)
  25. function pass_1 : tnode;override;
  26. function det_resulttype:tnode;override;
  27. protected
  28. {$ifndef cpu64bit}
  29. { override the following if you want to implement }
  30. { parts explicitely in the code generator (JM) }
  31. function first_moddiv64bitint: tnode; virtual;
  32. {$endif cpu64bit}
  33. function firstoptimize: tnode; virtual;
  34. function first_moddivint: tnode; virtual;
  35. end;
  36. tmoddivnodeclass = class of tmoddivnode;
  37. tshlshrnode = class(tbinopnode)
  38. function pass_1 : tnode;override;
  39. function det_resulttype:tnode;override;
  40. {$ifndef cpu64bit}
  41. { override the following if you want to implement }
  42. { parts explicitely in the code generator (CEC)
  43. Should return nil, if everything will be handled
  44. in the code generator
  45. }
  46. function first_shlshr64bitint: tnode; virtual;
  47. {$endif cpu64bit}
  48. end;
  49. tshlshrnodeclass = class of tshlshrnode;
  50. tunaryminusnode = class(tunarynode)
  51. constructor create(expr : tnode);virtual;
  52. function pass_1 : tnode;override;
  53. function det_resulttype:tnode;override;
  54. end;
  55. tunaryminusnodeclass = class of tunaryminusnode;
  56. tnotnode = class(tunarynode)
  57. constructor create(expr : tnode);virtual;
  58. function pass_1 : tnode;override;
  59. function det_resulttype:tnode;override;
  60. {$ifdef state_tracking}
  61. function track_state_pass(exec_known:boolean):boolean;override;
  62. {$endif}
  63. end;
  64. tnotnodeclass = class of tnotnode;
  65. var
  66. cmoddivnode : tmoddivnodeclass;
  67. cshlshrnode : tshlshrnodeclass;
  68. cunaryminusnode : tunaryminusnodeclass;
  69. cnotnode : tnotnodeclass;
  70. implementation
  71. uses
  72. systems,
  73. verbose,globals,cutils,
  74. globtype,
  75. symconst,symtype,symdef,defutil,
  76. htypechk,pass_1,
  77. cgbase,
  78. ncon,ncnv,ncal,nadd;
  79. {****************************************************************************
  80. TMODDIVNODE
  81. ****************************************************************************}
  82. function tmoddivnode.det_resulttype:tnode;
  83. var
  84. hp,t : tnode;
  85. rd,ld : torddef;
  86. rv,lv : tconstexprint;
  87. begin
  88. result:=nil;
  89. resulttypepass(left);
  90. resulttypepass(right);
  91. set_varstate(left,vs_used,true);
  92. set_varstate(right,vs_used,true);
  93. if codegenerror then
  94. exit;
  95. { we need 2 orddefs always }
  96. if (left.resulttype.def.deftype<>orddef) then
  97. inserttypeconv(right,sinttype);
  98. if (right.resulttype.def.deftype<>orddef) then
  99. inserttypeconv(right,sinttype);
  100. if codegenerror then
  101. exit;
  102. rd:=torddef(right.resulttype.def);
  103. ld:=torddef(left.resulttype.def);
  104. { check for division by zero }
  105. if is_constintnode(right) then
  106. begin
  107. rv:=tordconstnode(right).value;
  108. if (rv=0) then
  109. begin
  110. Message(parser_e_division_by_zero);
  111. { recover }
  112. rv:=1;
  113. end;
  114. if is_constintnode(left) then
  115. begin
  116. lv:=tordconstnode(left).value;
  117. case nodetype of
  118. modn:
  119. if (torddef(ld).typ <> u64bit) or
  120. (torddef(rd).typ <> u64bit) then
  121. t:=genintconstnode(lv mod rv)
  122. else
  123. t:=genintconstnode(int64(qword(lv) mod qword(rv)));
  124. divn:
  125. if (torddef(ld).typ <> u64bit) or
  126. (torddef(rd).typ <> u64bit) then
  127. t:=genintconstnode(lv div rv)
  128. else
  129. t:=genintconstnode(int64(qword(lv) div qword(rv)));
  130. end;
  131. result:=t;
  132. exit;
  133. end;
  134. end;
  135. { allow operator overloading }
  136. t:=self;
  137. if isbinaryoverloaded(t) then
  138. begin
  139. result:=t;
  140. exit;
  141. end;
  142. { if one operand is a cardinal and the other is a positive constant, convert the }
  143. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  144. { Do the same for qwords and positive constants as well, otherwise things like }
  145. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  146. { "qword" was > high(int64) (JM) }
  147. if (rd.typ in [u32bit,u64bit]) and
  148. is_constintnode(left) and
  149. (tordconstnode(left).value >= 0) then
  150. begin
  151. inserttypeconv(left,right.resulttype);
  152. ld:=torddef(left.resulttype.def);
  153. end;
  154. if (ld.typ in [u32bit,u64bit]) and
  155. is_constintnode(right) and
  156. (tordconstnode(right).value >= 0) then
  157. begin
  158. inserttypeconv(right,left.resulttype);
  159. rd:=torddef(right.resulttype.def);
  160. end;
  161. { when there is one currency value, everything is done
  162. using currency }
  163. if (ld.typ=scurrency) or
  164. (rd.typ=scurrency) then
  165. begin
  166. if (ld.typ<>scurrency) then
  167. inserttypeconv(left,s64currencytype);
  168. if (rd.typ<>scurrency) then
  169. inserttypeconv(right,s64currencytype);
  170. resulttype:=left.resulttype;
  171. end
  172. else
  173. {$ifndef cpu64bit}
  174. { when there is one 64bit value, everything is done
  175. in 64bit }
  176. if (is_64bitint(left.resulttype.def) or
  177. is_64bitint(right.resulttype.def)) then
  178. begin
  179. if is_signed(rd) or is_signed(ld) then
  180. begin
  181. if (ld.typ<>s64bit) then
  182. inserttypeconv(left,s64inttype);
  183. if (rd.typ<>s64bit) then
  184. inserttypeconv(right,s64inttype);
  185. end
  186. else
  187. begin
  188. if (ld.typ<>u64bit) then
  189. inserttypeconv(left,u64inttype);
  190. if (rd.typ<>u64bit) then
  191. inserttypeconv(right,u64inttype);
  192. end;
  193. resulttype:=left.resulttype;
  194. end
  195. else
  196. { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
  197. if ((rd.typ = u32bit) and
  198. is_signed(ld)) or
  199. ((ld.typ = u32bit) and
  200. is_signed(rd)) then
  201. begin
  202. CGMessage(type_w_mixed_signed_unsigned);
  203. if (ld.typ<>s64bit) then
  204. inserttypeconv(left,s64inttype);
  205. if (rd.typ<>s64bit) then
  206. inserttypeconv(right,s64inttype);
  207. resulttype:=left.resulttype;
  208. end
  209. else
  210. {$endif cpu64bit}
  211. begin
  212. { Make everything always default singed int }
  213. if not(rd.typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  214. inserttypeconv(right,sinttype);
  215. if not(ld.typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  216. inserttypeconv(left,sinttype);
  217. resulttype:=right.resulttype;
  218. end;
  219. { when the result is currency we need some extra code for
  220. division. this should not be done when the divn node is
  221. created internally }
  222. if (nodetype=divn) and
  223. not(nf_is_currency in flags) and
  224. is_currency(resulttype.def) then
  225. begin
  226. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  227. include(hp.flags,nf_is_currency);
  228. result:=hp;
  229. end;
  230. end;
  231. function tmoddivnode.first_moddivint: tnode;
  232. {$ifdef cpuneedsdiv32helper}
  233. var
  234. procname: string[31];
  235. begin
  236. result := nil;
  237. { otherwise create a call to a helper }
  238. if nodetype = divn then
  239. procname := 'fpc_div_'
  240. else
  241. procname := 'fpc_mod_';
  242. { only qword needs the unsigned code, the
  243. signed code is also used for currency }
  244. if is_signed(resulttype.def) then
  245. procname := procname + 'longint'
  246. else
  247. procname := procname + 'dword';
  248. result := ccallnode.createintern(procname,ccallparanode.create(left,
  249. ccallparanode.create(right,nil)));
  250. left := nil;
  251. right := nil;
  252. firstpass(result);
  253. end;
  254. {$else cpuneedsdiv32helper}
  255. begin
  256. result:=nil;
  257. end;
  258. {$endif cpuneedsdiv32helper}
  259. {$ifndef cpu64bit}
  260. function tmoddivnode.first_moddiv64bitint: tnode;
  261. var
  262. procname: string[31];
  263. begin
  264. result := nil;
  265. { when currency is used set the result of the
  266. parameters to s64bit, so they are not converted }
  267. if is_currency(resulttype.def) then
  268. begin
  269. left.resulttype:=s64inttype;
  270. right.resulttype:=s64inttype;
  271. end;
  272. { otherwise create a call to a helper }
  273. if nodetype = divn then
  274. procname := 'fpc_div_'
  275. else
  276. procname := 'fpc_mod_';
  277. { only qword needs the unsigned code, the
  278. signed code is also used for currency }
  279. if is_signed(resulttype.def) then
  280. procname := procname + 'int64'
  281. else
  282. procname := procname + 'qword';
  283. result := ccallnode.createintern(procname,ccallparanode.create(left,
  284. ccallparanode.create(right,nil)));
  285. left := nil;
  286. right := nil;
  287. firstpass(result);
  288. end;
  289. {$endif cpu64bit}
  290. function tmoddivnode.firstoptimize: tnode;
  291. var
  292. power{,shiftval} : longint;
  293. newtype: tnodetype;
  294. begin
  295. result := nil;
  296. { divide/mod a number by a constant which is a power of 2? }
  297. if (cs_optimize in aktglobalswitches) and
  298. (right.nodetype = ordconstn) and
  299. { ((nodetype = divn) or
  300. not is_signed(resulttype.def)) and}
  301. (not is_signed(resulttype.def)) and
  302. ispowerof2(tordconstnode(right).value,power) then
  303. begin
  304. if nodetype = divn then
  305. begin
  306. (*
  307. if is_signed(resulttype.def) then
  308. begin
  309. if is_64bitint(left.resulttype.def) then
  310. if not (cs_littlesize in aktglobalswitches) then
  311. shiftval := 63
  312. else
  313. { the shift code is a lot bigger than the call to }
  314. { the divide helper }
  315. exit
  316. else
  317. shiftval := 31;
  318. { we reuse left twice, so create once a copy of it }
  319. { !!! if left is a call is -> call gets executed twice }
  320. left := caddnode.create(addn,left,
  321. caddnode.create(andn,
  322. cshlshrnode.create(sarn,left.getcopy,
  323. cordconstnode.create(shiftval,sinttype,false)),
  324. cordconstnode.create(tordconstnode(right).value-1,
  325. right.resulttype,false)));
  326. newtype := sarn;
  327. end
  328. else
  329. *)
  330. newtype := shrn;
  331. tordconstnode(right).value := power;
  332. result := cshlshrnode.create(newtype,left,right)
  333. end
  334. else
  335. begin
  336. dec(tordconstnode(right).value);
  337. result := caddnode.create(andn,left,right);
  338. end;
  339. { left and right are reused }
  340. left := nil;
  341. right := nil;
  342. firstpass(result);
  343. exit;
  344. end;
  345. end;
  346. function tmoddivnode.pass_1 : tnode;
  347. begin
  348. result:=nil;
  349. firstpass(left);
  350. firstpass(right);
  351. if codegenerror then
  352. exit;
  353. { Try to optimize mod/div }
  354. result := firstoptimize;
  355. if assigned(result) then
  356. exit;
  357. {$ifndef cpu64bit}
  358. { 64bit }
  359. if (left.resulttype.def.deftype=orddef) and
  360. (right.resulttype.def.deftype=orddef) and
  361. (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
  362. begin
  363. result := first_moddiv64bitint;
  364. if assigned(result) then
  365. exit;
  366. expectloc:=LOC_REGISTER;
  367. calcregisters(self,2,0,0);
  368. end
  369. else
  370. {$endif cpu64bit}
  371. begin
  372. result := first_moddivint;
  373. if assigned(result) then
  374. exit;
  375. left_right_max;
  376. if left.registersint<=right.registersint then
  377. inc(registersint);
  378. end;
  379. expectloc:=LOC_REGISTER;
  380. end;
  381. {****************************************************************************
  382. TSHLSHRNODE
  383. ****************************************************************************}
  384. function tshlshrnode.det_resulttype:tnode;
  385. var
  386. t : tnode;
  387. begin
  388. result:=nil;
  389. resulttypepass(left);
  390. resulttypepass(right);
  391. set_varstate(right,vs_used,true);
  392. set_varstate(left,vs_used,true);
  393. if codegenerror then
  394. exit;
  395. { constant folding }
  396. if is_constintnode(left) and is_constintnode(right) then
  397. begin
  398. case nodetype of
  399. shrn:
  400. t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
  401. shln:
  402. t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
  403. end;
  404. result:=t;
  405. exit;
  406. end;
  407. { allow operator overloading }
  408. t:=self;
  409. if isbinaryoverloaded(t) then
  410. begin
  411. result:=t;
  412. exit;
  413. end;
  414. { calculations for ordinals < 32 bit have to be done in
  415. 32 bit for backwards compatibility. That way 'shl 33' is
  416. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  417. if (not is_64bit(left.resulttype.def)) and
  418. (torddef(left.resulttype.def).typ<>u32bit) then
  419. inserttypeconv(left,s32inttype);
  420. inserttypeconv(right,sinttype);
  421. resulttype:=left.resulttype;
  422. end;
  423. {$ifndef cpu64bit}
  424. function tshlshrnode.first_shlshr64bitint: tnode;
  425. var
  426. procname: string[31];
  427. begin
  428. result := nil;
  429. { otherwise create a call to a helper }
  430. if nodetype = shln then
  431. procname := 'fpc_shl_int64'
  432. else
  433. procname := 'fpc_shr_int64';
  434. { this order of parameters works at least for the arm,
  435. however it should work for any calling conventions (FK) }
  436. result := ccallnode.createintern(procname,ccallparanode.create(right,
  437. ccallparanode.create(left,nil)));
  438. left := nil;
  439. right := nil;
  440. firstpass(result);
  441. end;
  442. {$endif cpu64bit}
  443. function tshlshrnode.pass_1 : tnode;
  444. var
  445. regs : longint;
  446. begin
  447. result:=nil;
  448. firstpass(left);
  449. firstpass(right);
  450. if codegenerror then
  451. exit;
  452. {$ifndef cpu64bit}
  453. { 64 bit ints have their own shift handling }
  454. if is_64bit(left.resulttype.def) then
  455. begin
  456. result := first_shlshr64bitint;
  457. if assigned(result) then
  458. exit;
  459. regs:=2;
  460. end
  461. else
  462. {$endif cpu64bit}
  463. begin
  464. regs:=1
  465. end;
  466. if (right.nodetype<>ordconstn) then
  467. inc(regs);
  468. expectloc:=LOC_REGISTER;
  469. calcregisters(self,regs,0,0);
  470. end;
  471. {****************************************************************************
  472. TUNARYMINUSNODE
  473. ****************************************************************************}
  474. constructor tunaryminusnode.create(expr : tnode);
  475. begin
  476. inherited create(unaryminusn,expr);
  477. end;
  478. function tunaryminusnode.det_resulttype : tnode;
  479. var
  480. t : tnode;
  481. begin
  482. result:=nil;
  483. resulttypepass(left);
  484. set_varstate(left,vs_used,true);
  485. if codegenerror then
  486. exit;
  487. { constant folding }
  488. if is_constintnode(left) then
  489. begin
  490. result:=genintconstnode(-tordconstnode(left).value);
  491. exit;
  492. end;
  493. if is_constrealnode(left) then
  494. begin
  495. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  496. result:=left;
  497. left:=nil;
  498. exit;
  499. end;
  500. resulttype:=left.resulttype;
  501. if (left.resulttype.def.deftype=floatdef) then
  502. begin
  503. end
  504. {$ifdef SUPPORT_MMX}
  505. else if (cs_mmx in aktlocalswitches) and
  506. is_mmx_able_array(left.resulttype.def) then
  507. begin
  508. { if saturation is on, left.resulttype.def isn't
  509. "mmx able" (FK)
  510. if (cs_mmx_saturation in aktlocalswitches^) and
  511. (torddef(tarraydef(resulttype.def).definition).typ in
  512. [s32bit,u32bit]) then
  513. CGMessage(type_e_mismatch);
  514. }
  515. end
  516. {$endif SUPPORT_MMX}
  517. {$ifndef cpu64bit}
  518. else if is_64bitint(left.resulttype.def) then
  519. begin
  520. end
  521. {$endif cpu64bit}
  522. else if (left.resulttype.def.deftype=orddef) then
  523. begin
  524. inserttypeconv(left,sinttype);
  525. resulttype:=left.resulttype;
  526. end
  527. else
  528. begin
  529. { allow operator overloading }
  530. t:=self;
  531. if isunaryoverloaded(t) then
  532. begin
  533. result:=t;
  534. exit;
  535. end;
  536. CGMessage(type_e_mismatch);
  537. end;
  538. end;
  539. { generic code }
  540. { overridden by: }
  541. { i386 }
  542. function tunaryminusnode.pass_1 : tnode;
  543. begin
  544. result:=nil;
  545. firstpass(left);
  546. if codegenerror then
  547. exit;
  548. registersint:=left.registersint;
  549. registersfpu:=left.registersfpu;
  550. {$ifdef SUPPORT_MMX}
  551. registersmmx:=left.registersmmx;
  552. {$endif SUPPORT_MMX}
  553. if (left.resulttype.def.deftype=floatdef) then
  554. begin
  555. if (left.expectloc<>LOC_REGISTER) and
  556. (registersfpu<1) then
  557. registersfpu:=1;
  558. expectloc:=LOC_FPUREGISTER;
  559. end
  560. {$ifdef SUPPORT_MMX}
  561. else if (cs_mmx in aktlocalswitches) and
  562. is_mmx_able_array(left.resulttype.def) then
  563. begin
  564. if (left.expectloc<>LOC_MMXREGISTER) and
  565. (registersmmx<1) then
  566. registersmmx:=1;
  567. end
  568. {$endif SUPPORT_MMX}
  569. {$ifndef cpu64bit}
  570. else if is_64bit(left.resulttype.def) then
  571. begin
  572. if (left.expectloc<>LOC_REGISTER) and
  573. (registersint<2) then
  574. registersint:=2;
  575. expectloc:=LOC_REGISTER;
  576. end
  577. {$endif cpu64bit}
  578. else if (left.resulttype.def.deftype=orddef) then
  579. begin
  580. if (left.expectloc<>LOC_REGISTER) and
  581. (registersint<1) then
  582. registersint:=1;
  583. expectloc:=LOC_REGISTER;
  584. end;
  585. end;
  586. {****************************************************************************
  587. TNOTNODE
  588. ****************************************************************************}
  589. const
  590. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  591. gten,gtn,lten,ltn,unequaln,equaln
  592. );
  593. constructor tnotnode.create(expr : tnode);
  594. begin
  595. inherited create(notn,expr);
  596. end;
  597. function tnotnode.det_resulttype : tnode;
  598. var
  599. t : tnode;
  600. tt : ttype;
  601. v : tconstexprint;
  602. begin
  603. result:=nil;
  604. resulttypepass(left);
  605. set_varstate(left,vs_used,true);
  606. if codegenerror then
  607. exit;
  608. resulttype:=left.resulttype;
  609. { Try optmimizing ourself away }
  610. if left.nodetype=notn then
  611. begin
  612. { Double not. Remove both }
  613. result:=Tnotnode(left).left;
  614. Tnotnode(left).left:=nil;
  615. exit;
  616. end;
  617. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  618. begin
  619. { Not of boolean expression. Turn around the operator and remove
  620. the not. This is not allowed for sets with the gten/lten,
  621. because there is no ltn/gtn support }
  622. if (taddnode(left).left.resulttype.def.deftype<>setdef) or
  623. (left.nodetype in [equaln,unequaln]) then
  624. begin
  625. result:=left;
  626. left.nodetype:=boolean_reverse[left.nodetype];
  627. left:=nil;
  628. exit;
  629. end;
  630. end;
  631. { constant folding }
  632. if (left.nodetype=ordconstn) then
  633. begin
  634. v:=tordconstnode(left).value;
  635. tt:=left.resulttype;
  636. case torddef(left.resulttype.def).typ of
  637. bool8bit,
  638. bool16bit,
  639. bool32bit :
  640. begin
  641. { here we do a boolean(byte(..)) type cast because }
  642. { boolean(<int64>) is buggy in 1.00 }
  643. v:=byte(not(boolean(byte(v))));
  644. end;
  645. uchar,
  646. uwidechar,
  647. u8bit,
  648. s8bit,
  649. u16bit,
  650. s16bit,
  651. u32bit,
  652. s32bit,
  653. s64bit,
  654. u64bit :
  655. begin
  656. v:=int64(not int64(v)); { maybe qword is required }
  657. int_to_type(v,tt);
  658. end;
  659. else
  660. CGMessage(type_e_mismatch);
  661. end;
  662. t:=cordconstnode.create(v,tt,true);
  663. result:=t;
  664. exit;
  665. end;
  666. if is_boolean(resulttype.def) then
  667. begin
  668. end
  669. else
  670. {$ifdef SUPPORT_MMX}
  671. if (cs_mmx in aktlocalswitches) and
  672. is_mmx_able_array(left.resulttype.def) then
  673. begin
  674. end
  675. else
  676. {$endif SUPPORT_MMX}
  677. {$ifndef cpu64bit}
  678. if is_64bitint(left.resulttype.def) then
  679. begin
  680. end
  681. else
  682. {$endif cpu64bit}
  683. if is_integer(left.resulttype.def) then
  684. begin
  685. end
  686. else
  687. begin
  688. { allow operator overloading }
  689. t:=self;
  690. if isunaryoverloaded(t) then
  691. begin
  692. result:=t;
  693. exit;
  694. end;
  695. CGMessage(type_e_mismatch);
  696. end;
  697. end;
  698. function tnotnode.pass_1 : tnode;
  699. begin
  700. result:=nil;
  701. firstpass(left);
  702. if codegenerror then
  703. exit;
  704. expectloc:=left.expectloc;
  705. registersint:=left.registersint;
  706. {$ifdef SUPPORT_MMX}
  707. registersmmx:=left.registersmmx;
  708. {$endif SUPPORT_MMX}
  709. if is_boolean(resulttype.def) then
  710. begin
  711. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  712. begin
  713. expectloc:=LOC_REGISTER;
  714. if (registersint<1) then
  715. registersint:=1;
  716. end;
  717. { before loading it into flags we need to load it into
  718. a register thus 1 register is need PM }
  719. {$ifdef cpuflags}
  720. if left.expectloc<>LOC_JUMP then
  721. expectloc:=LOC_FLAGS;
  722. {$endif def cpuflags}
  723. end
  724. else
  725. {$ifdef SUPPORT_MMX}
  726. if (cs_mmx in aktlocalswitches) and
  727. is_mmx_able_array(left.resulttype.def) then
  728. begin
  729. if (left.expectloc<>LOC_MMXREGISTER) and
  730. (registersmmx<1) then
  731. registersmmx:=1;
  732. end
  733. else
  734. {$endif SUPPORT_MMX}
  735. {$ifndef cpu64bit}
  736. if is_64bit(left.resulttype.def) then
  737. begin
  738. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  739. begin
  740. expectloc:=LOC_REGISTER;
  741. if (registersint<2) then
  742. registersint:=2;
  743. end;
  744. end
  745. else
  746. {$endif cpu64bit}
  747. if is_integer(left.resulttype.def) then
  748. begin
  749. if (left.expectloc<>LOC_REGISTER) and
  750. (registersint<1) then
  751. registersint:=1;
  752. expectloc:=LOC_REGISTER;
  753. end;
  754. end;
  755. {$ifdef state_tracking}
  756. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  757. begin
  758. track_state_pass:=true;
  759. if left.track_state_pass(exec_known) then
  760. begin
  761. left.resulttype.def:=nil;
  762. do_resulttypepass(left);
  763. end;
  764. end;
  765. {$endif}
  766. begin
  767. cmoddivnode:=tmoddivnode;
  768. cshlshrnode:=tshlshrnode;
  769. cunaryminusnode:=tunaryminusnode;
  770. cnotnode:=tnotnode;
  771. end.
  772. {
  773. $Log$
  774. Revision 1.64 2004-06-16 20:07:09 florian
  775. * dwarf branch merged
  776. Revision 1.63 2004/05/28 21:14:34 peter
  777. * fixed div qword
  778. Revision 1.62 2004/05/19 23:29:25 peter
  779. * don't change sign for unsigned shl/shr operations
  780. * cleanup for u32bit
  781. Revision 1.61.2.1 2004/05/03 16:27:38 peter
  782. * fixed shl for x86-64
  783. Revision 1.61 2004/03/29 14:44:10 peter
  784. * fixes to previous constant integer commit
  785. Revision 1.60 2004/03/23 22:34:49 peter
  786. * constants ordinals now always have a type assigned
  787. * integer constants have the smallest type, unsigned prefered over
  788. signed
  789. Revision 1.59 2004/02/24 16:12:39 peter
  790. * operator overload chooses rewrite
  791. * overload choosing is now generic and moved to htypechk
  792. Revision 1.58 2004/02/04 22:15:15 daniel
  793. * Rtti generation moved to ncgutil
  794. * Assmtai usage of symsym removed
  795. * operator overloading cleanup up
  796. Revision 1.57 2004/02/04 19:22:27 peter
  797. *** empty log message ***
  798. Revision 1.56 2004/02/03 22:32:54 peter
  799. * renamed xNNbittype to xNNinttype
  800. * renamed registers32 to registersint
  801. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  802. Revision 1.55 2004/01/23 15:12:49 florian
  803. * fixed generic shl/shr operations
  804. + added register allocation hook calls for arm specific operand types:
  805. register set and shifter op
  806. Revision 1.54 2003/12/09 21:17:04 jonas
  807. + support for evaluating qword constant expressions (both arguments have
  808. to be a qword, constants have to be explicitly typecasted to qword)
  809. Revision 1.53 2003/10/08 19:19:45 peter
  810. * set_varstate cleanup
  811. Revision 1.52 2003/10/01 20:34:49 peter
  812. * procinfo unit contains tprocinfo
  813. * cginfo renamed to cgbase
  814. * moved cgmessage to verbose
  815. * fixed ppc and sparc compiles
  816. Revision 1.51 2003/09/07 22:09:35 peter
  817. * preparations for different default calling conventions
  818. * various RA fixes
  819. Revision 1.50 2003/09/03 11:18:37 florian
  820. * fixed arm concatcopy
  821. + arm support in the common compiler sources added
  822. * moved some generic cg code around
  823. + tfputype added
  824. * ...
  825. Revision 1.49 2003/05/24 16:32:34 jonas
  826. * fixed expectloc of notnode for all processors that have flags
  827. Revision 1.48 2003/05/09 17:47:02 peter
  828. * self moved to hidden parameter
  829. * removed hdisposen,hnewn,selfn
  830. Revision 1.47 2003/04/25 20:59:33 peter
  831. * removed funcretn,funcretsym, function result is now in varsym
  832. and aliases for result and function name are added using absolutesym
  833. * vs_hidden parameter for funcret passed in parameter
  834. * vs_hidden fixes
  835. * writenode changed to printnode and released from extdebug
  836. * -vp option added to generate a tree.log with the nodetree
  837. * nicer printnode for statements, callnode
  838. Revision 1.46 2003/04/23 20:16:04 peter
  839. + added currency support based on int64
  840. + is_64bit for use in cg units instead of is_64bitint
  841. * removed cgmessage from n386add, replace with internalerrors
  842. Revision 1.45 2003/04/22 23:50:23 peter
  843. * firstpass uses expectloc
  844. * checks if there are differences between the expectloc and
  845. location.loc from secondpass in EXTDEBUG
  846. Revision 1.44 2002/11/25 17:43:20 peter
  847. * splitted defbase in defutil,symutil,defcmp
  848. * merged isconvertable and is_equal into compare_defs(_ext)
  849. * made operator search faster by walking the list only once
  850. Revision 1.43 2002/10/04 21:19:28 jonas
  851. * fixed web bug 2139: checking for division by zero fixed
  852. Revision 1.42 2002/09/07 12:16:04 carl
  853. * second part bug report 1996 fix, testrange in cordconstnode
  854. only called if option is set (also make parsing a tiny faster)
  855. Revision 1.41 2002/09/03 16:26:26 daniel
  856. * Make Tprocdef.defs protected
  857. Revision 1.40 2002/08/25 11:32:33 peter
  858. * don't optimize not([lten,gten]) for setdefs
  859. Revision 1.39 2002/08/25 09:10:58 peter
  860. * fixed not(not()) removal
  861. Revision 1.38 2002/08/15 15:09:42 carl
  862. + fpu emulation helpers (ppu checking also)
  863. Revision 1.37 2002/08/14 19:26:55 carl
  864. + generic int_to_real type conversion
  865. + generic unaryminus node
  866. Revision 1.36 2002/07/20 11:57:54 florian
  867. * types.pas renamed to defbase.pas because D6 contains a types
  868. unit so this would conflicts if D6 programms are compiled
  869. + Willamette/SSE2 instructions to assembler added
  870. Revision 1.35 2002/07/19 11:41:36 daniel
  871. * State tracker work
  872. * The whilen and repeatn are now completely unified into whilerepeatn. This
  873. allows the state tracker to change while nodes automatically into
  874. repeat nodes.
  875. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  876. 'not(a>b)' is optimized into 'a<=b'.
  877. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  878. by removing the notn and later switchting the true and falselabels. The
  879. same is done with 'repeat until not a'.
  880. Revision 1.34 2002/05/18 13:34:10 peter
  881. * readded missing revisions
  882. Revision 1.33 2002/05/16 19:46:39 carl
  883. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  884. + try to fix temp allocation (still in ifdef)
  885. + generic constructor calls
  886. + start of tassembler / tmodulebase class cleanup
  887. Revision 1.31 2002/04/07 13:26:10 carl
  888. + change unit use
  889. Revision 1.30 2002/04/02 17:11:29 peter
  890. * tlocation,treference update
  891. * LOC_CONSTANT added for better constant handling
  892. * secondadd splitted in multiple routines
  893. * location_force_reg added for loading a location to a register
  894. of a specified size
  895. * secondassignment parses now first the right and then the left node
  896. (this is compatible with Kylix). This saves a lot of push/pop especially
  897. with string operations
  898. * adapted some routines to use the new cg methods
  899. Revision 1.29 2002/03/04 19:10:11 peter
  900. * removed compiler warnings
  901. Revision 1.28 2002/02/11 11:45:51 michael
  902. * Compilation without mmx support fixed from Peter
  903. }