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. { expand to cpu wordsize, but don't change sign. For
  415. 32bit ignore 64bit since that has it's own code }
  416. {$ifndef cpu64bit}
  417. if not is_64bit(left.resulttype.def) then
  418. {$endif}
  419. begin
  420. { constants generate signed integers }
  421. if is_signed(left.resulttype.def) then
  422. inserttypeconv(left,sinttype)
  423. else
  424. inserttypeconv(left,uinttype);
  425. end;
  426. inserttypeconv(right,sinttype);
  427. resulttype:=left.resulttype;
  428. end;
  429. {$ifndef cpu64bit}
  430. function tshlshrnode.first_shlshr64bitint: tnode;
  431. var
  432. procname: string[31];
  433. begin
  434. result := nil;
  435. { otherwise create a call to a helper }
  436. if nodetype = shln then
  437. procname := 'fpc_shl_int64'
  438. else
  439. procname := 'fpc_shr_int64';
  440. { this order of parameters works at least for the arm,
  441. however it should work for any calling conventions (FK) }
  442. result := ccallnode.createintern(procname,ccallparanode.create(right,
  443. ccallparanode.create(left,nil)));
  444. left := nil;
  445. right := nil;
  446. firstpass(result);
  447. end;
  448. {$endif cpu64bit}
  449. function tshlshrnode.pass_1 : tnode;
  450. var
  451. regs : longint;
  452. begin
  453. result:=nil;
  454. firstpass(left);
  455. firstpass(right);
  456. if codegenerror then
  457. exit;
  458. {$ifndef cpu64bit}
  459. { 64 bit ints have their own shift handling }
  460. if is_64bit(left.resulttype.def) then
  461. begin
  462. result := first_shlshr64bitint;
  463. if assigned(result) then
  464. exit;
  465. regs:=2;
  466. end
  467. else
  468. {$endif cpu64bit}
  469. begin
  470. regs:=1
  471. end;
  472. if (right.nodetype<>ordconstn) then
  473. inc(regs);
  474. expectloc:=LOC_REGISTER;
  475. calcregisters(self,regs,0,0);
  476. end;
  477. {****************************************************************************
  478. TUNARYMINUSNODE
  479. ****************************************************************************}
  480. constructor tunaryminusnode.create(expr : tnode);
  481. begin
  482. inherited create(unaryminusn,expr);
  483. end;
  484. function tunaryminusnode.det_resulttype : tnode;
  485. var
  486. t : tnode;
  487. begin
  488. result:=nil;
  489. resulttypepass(left);
  490. set_varstate(left,vs_used,true);
  491. if codegenerror then
  492. exit;
  493. { constant folding }
  494. if is_constintnode(left) then
  495. begin
  496. result:=genintconstnode(-tordconstnode(left).value);
  497. exit;
  498. end;
  499. if is_constrealnode(left) then
  500. begin
  501. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  502. result:=left;
  503. left:=nil;
  504. exit;
  505. end;
  506. resulttype:=left.resulttype;
  507. if (left.resulttype.def.deftype=floatdef) then
  508. begin
  509. end
  510. {$ifdef SUPPORT_MMX}
  511. else if (cs_mmx in aktlocalswitches) and
  512. is_mmx_able_array(left.resulttype.def) then
  513. begin
  514. { if saturation is on, left.resulttype.def isn't
  515. "mmx able" (FK)
  516. if (cs_mmx_saturation in aktlocalswitches^) and
  517. (torddef(tarraydef(resulttype.def).definition).typ in
  518. [s32bit,u32bit]) then
  519. CGMessage(type_e_mismatch);
  520. }
  521. end
  522. {$endif SUPPORT_MMX}
  523. {$ifndef cpu64bit}
  524. else if is_64bitint(left.resulttype.def) then
  525. begin
  526. end
  527. {$endif cpu64bit}
  528. else if (left.resulttype.def.deftype=orddef) then
  529. begin
  530. inserttypeconv(left,sinttype);
  531. resulttype:=left.resulttype;
  532. end
  533. else
  534. begin
  535. { allow operator overloading }
  536. t:=self;
  537. if isunaryoverloaded(t) then
  538. begin
  539. result:=t;
  540. exit;
  541. end;
  542. CGMessage(type_e_mismatch);
  543. end;
  544. end;
  545. { generic code }
  546. { overridden by: }
  547. { i386 }
  548. function tunaryminusnode.pass_1 : tnode;
  549. begin
  550. result:=nil;
  551. firstpass(left);
  552. if codegenerror then
  553. exit;
  554. registersint:=left.registersint;
  555. registersfpu:=left.registersfpu;
  556. {$ifdef SUPPORT_MMX}
  557. registersmmx:=left.registersmmx;
  558. {$endif SUPPORT_MMX}
  559. if (left.resulttype.def.deftype=floatdef) then
  560. begin
  561. if (left.expectloc<>LOC_REGISTER) and
  562. (registersfpu<1) then
  563. registersfpu:=1;
  564. expectloc:=LOC_FPUREGISTER;
  565. end
  566. {$ifdef SUPPORT_MMX}
  567. else if (cs_mmx in aktlocalswitches) and
  568. is_mmx_able_array(left.resulttype.def) then
  569. begin
  570. if (left.expectloc<>LOC_MMXREGISTER) and
  571. (registersmmx<1) then
  572. registersmmx:=1;
  573. end
  574. {$endif SUPPORT_MMX}
  575. {$ifndef cpu64bit}
  576. else if is_64bit(left.resulttype.def) then
  577. begin
  578. if (left.expectloc<>LOC_REGISTER) and
  579. (registersint<2) then
  580. registersint:=2;
  581. expectloc:=LOC_REGISTER;
  582. end
  583. {$endif cpu64bit}
  584. else if (left.resulttype.def.deftype=orddef) then
  585. begin
  586. if (left.expectloc<>LOC_REGISTER) and
  587. (registersint<1) then
  588. registersint:=1;
  589. expectloc:=LOC_REGISTER;
  590. end;
  591. end;
  592. {****************************************************************************
  593. TNOTNODE
  594. ****************************************************************************}
  595. const
  596. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  597. gten,gtn,lten,ltn,unequaln,equaln
  598. );
  599. constructor tnotnode.create(expr : tnode);
  600. begin
  601. inherited create(notn,expr);
  602. end;
  603. function tnotnode.det_resulttype : tnode;
  604. var
  605. t : tnode;
  606. tt : ttype;
  607. v : tconstexprint;
  608. begin
  609. result:=nil;
  610. resulttypepass(left);
  611. set_varstate(left,vs_used,true);
  612. if codegenerror then
  613. exit;
  614. resulttype:=left.resulttype;
  615. { Try optmimizing ourself away }
  616. if left.nodetype=notn then
  617. begin
  618. { Double not. Remove both }
  619. result:=Tnotnode(left).left;
  620. Tnotnode(left).left:=nil;
  621. exit;
  622. end;
  623. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  624. begin
  625. { Not of boolean expression. Turn around the operator and remove
  626. the not. This is not allowed for sets with the gten/lten,
  627. because there is no ltn/gtn support }
  628. if (taddnode(left).left.resulttype.def.deftype<>setdef) or
  629. (left.nodetype in [equaln,unequaln]) then
  630. begin
  631. result:=left;
  632. left.nodetype:=boolean_reverse[left.nodetype];
  633. left:=nil;
  634. exit;
  635. end;
  636. end;
  637. { constant folding }
  638. if (left.nodetype=ordconstn) then
  639. begin
  640. v:=tordconstnode(left).value;
  641. tt:=left.resulttype;
  642. case torddef(left.resulttype.def).typ of
  643. bool8bit,
  644. bool16bit,
  645. bool32bit :
  646. begin
  647. { here we do a boolean(byte(..)) type cast because }
  648. { boolean(<int64>) is buggy in 1.00 }
  649. v:=byte(not(boolean(byte(v))));
  650. end;
  651. uchar,
  652. uwidechar,
  653. u8bit,
  654. s8bit,
  655. u16bit,
  656. s16bit,
  657. u32bit,
  658. s32bit,
  659. s64bit,
  660. u64bit :
  661. begin
  662. v:=int64(not int64(v)); { maybe qword is required }
  663. int_to_type(v,tt);
  664. end;
  665. else
  666. CGMessage(type_e_mismatch);
  667. end;
  668. t:=cordconstnode.create(v,tt,true);
  669. result:=t;
  670. exit;
  671. end;
  672. if is_boolean(resulttype.def) then
  673. begin
  674. end
  675. else
  676. {$ifdef SUPPORT_MMX}
  677. if (cs_mmx in aktlocalswitches) and
  678. is_mmx_able_array(left.resulttype.def) then
  679. begin
  680. end
  681. else
  682. {$endif SUPPORT_MMX}
  683. {$ifndef cpu64bit}
  684. if is_64bitint(left.resulttype.def) then
  685. begin
  686. end
  687. else
  688. {$endif cpu64bit}
  689. if is_integer(left.resulttype.def) then
  690. begin
  691. end
  692. else
  693. begin
  694. { allow operator overloading }
  695. t:=self;
  696. if isunaryoverloaded(t) then
  697. begin
  698. result:=t;
  699. exit;
  700. end;
  701. CGMessage(type_e_mismatch);
  702. end;
  703. end;
  704. function tnotnode.pass_1 : tnode;
  705. begin
  706. result:=nil;
  707. firstpass(left);
  708. if codegenerror then
  709. exit;
  710. expectloc:=left.expectloc;
  711. registersint:=left.registersint;
  712. {$ifdef SUPPORT_MMX}
  713. registersmmx:=left.registersmmx;
  714. {$endif SUPPORT_MMX}
  715. if is_boolean(resulttype.def) then
  716. begin
  717. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  718. begin
  719. expectloc:=LOC_REGISTER;
  720. if (registersint<1) then
  721. registersint:=1;
  722. end;
  723. { before loading it into flags we need to load it into
  724. a register thus 1 register is need PM }
  725. {$ifdef cpuflags}
  726. if left.expectloc<>LOC_JUMP then
  727. expectloc:=LOC_FLAGS;
  728. {$endif def cpuflags}
  729. end
  730. else
  731. {$ifdef SUPPORT_MMX}
  732. if (cs_mmx in aktlocalswitches) and
  733. is_mmx_able_array(left.resulttype.def) then
  734. begin
  735. if (left.expectloc<>LOC_MMXREGISTER) and
  736. (registersmmx<1) then
  737. registersmmx:=1;
  738. end
  739. else
  740. {$endif SUPPORT_MMX}
  741. {$ifndef cpu64bit}
  742. if is_64bit(left.resulttype.def) then
  743. begin
  744. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  745. begin
  746. expectloc:=LOC_REGISTER;
  747. if (registersint<2) then
  748. registersint:=2;
  749. end;
  750. end
  751. else
  752. {$endif cpu64bit}
  753. if is_integer(left.resulttype.def) then
  754. begin
  755. if (left.expectloc<>LOC_REGISTER) and
  756. (registersint<1) then
  757. registersint:=1;
  758. expectloc:=LOC_REGISTER;
  759. end;
  760. end;
  761. {$ifdef state_tracking}
  762. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  763. begin
  764. track_state_pass:=true;
  765. if left.track_state_pass(exec_known) then
  766. begin
  767. left.resulttype.def:=nil;
  768. do_resulttypepass(left);
  769. end;
  770. end;
  771. {$endif}
  772. begin
  773. cmoddivnode:=tmoddivnode;
  774. cshlshrnode:=tshlshrnode;
  775. cunaryminusnode:=tunaryminusnode;
  776. cnotnode:=tnotnode;
  777. end.
  778. {
  779. $Log$
  780. Revision 1.63 2004-05-28 21:14:34 peter
  781. * fixed div qword
  782. Revision 1.62 2004/05/19 23:29:25 peter
  783. * don't change sign for unsigned shl/shr operations
  784. * cleanup for u32bit
  785. Revision 1.61 2004/03/29 14:44:10 peter
  786. * fixes to previous constant integer commit
  787. Revision 1.60 2004/03/23 22:34:49 peter
  788. * constants ordinals now always have a type assigned
  789. * integer constants have the smallest type, unsigned prefered over
  790. signed
  791. Revision 1.59 2004/02/24 16:12:39 peter
  792. * operator overload chooses rewrite
  793. * overload choosing is now generic and moved to htypechk
  794. Revision 1.58 2004/02/04 22:15:15 daniel
  795. * Rtti generation moved to ncgutil
  796. * Assmtai usage of symsym removed
  797. * operator overloading cleanup up
  798. Revision 1.57 2004/02/04 19:22:27 peter
  799. *** empty log message ***
  800. Revision 1.56 2004/02/03 22:32:54 peter
  801. * renamed xNNbittype to xNNinttype
  802. * renamed registers32 to registersint
  803. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  804. Revision 1.55 2004/01/23 15:12:49 florian
  805. * fixed generic shl/shr operations
  806. + added register allocation hook calls for arm specific operand types:
  807. register set and shifter op
  808. Revision 1.54 2003/12/09 21:17:04 jonas
  809. + support for evaluating qword constant expressions (both arguments have
  810. to be a qword, constants have to be explicitly typecasted to qword)
  811. Revision 1.53 2003/10/08 19:19:45 peter
  812. * set_varstate cleanup
  813. Revision 1.52 2003/10/01 20:34:49 peter
  814. * procinfo unit contains tprocinfo
  815. * cginfo renamed to cgbase
  816. * moved cgmessage to verbose
  817. * fixed ppc and sparc compiles
  818. Revision 1.51 2003/09/07 22:09:35 peter
  819. * preparations for different default calling conventions
  820. * various RA fixes
  821. Revision 1.50 2003/09/03 11:18:37 florian
  822. * fixed arm concatcopy
  823. + arm support in the common compiler sources added
  824. * moved some generic cg code around
  825. + tfputype added
  826. * ...
  827. Revision 1.49 2003/05/24 16:32:34 jonas
  828. * fixed expectloc of notnode for all processors that have flags
  829. Revision 1.48 2003/05/09 17:47:02 peter
  830. * self moved to hidden parameter
  831. * removed hdisposen,hnewn,selfn
  832. Revision 1.47 2003/04/25 20:59:33 peter
  833. * removed funcretn,funcretsym, function result is now in varsym
  834. and aliases for result and function name are added using absolutesym
  835. * vs_hidden parameter for funcret passed in parameter
  836. * vs_hidden fixes
  837. * writenode changed to printnode and released from extdebug
  838. * -vp option added to generate a tree.log with the nodetree
  839. * nicer printnode for statements, callnode
  840. Revision 1.46 2003/04/23 20:16:04 peter
  841. + added currency support based on int64
  842. + is_64bit for use in cg units instead of is_64bitint
  843. * removed cgmessage from n386add, replace with internalerrors
  844. Revision 1.45 2003/04/22 23:50:23 peter
  845. * firstpass uses expectloc
  846. * checks if there are differences between the expectloc and
  847. location.loc from secondpass in EXTDEBUG
  848. Revision 1.44 2002/11/25 17:43:20 peter
  849. * splitted defbase in defutil,symutil,defcmp
  850. * merged isconvertable and is_equal into compare_defs(_ext)
  851. * made operator search faster by walking the list only once
  852. Revision 1.43 2002/10/04 21:19:28 jonas
  853. * fixed web bug 2139: checking for division by zero fixed
  854. Revision 1.42 2002/09/07 12:16:04 carl
  855. * second part bug report 1996 fix, testrange in cordconstnode
  856. only called if option is set (also make parsing a tiny faster)
  857. Revision 1.41 2002/09/03 16:26:26 daniel
  858. * Make Tprocdef.defs protected
  859. Revision 1.40 2002/08/25 11:32:33 peter
  860. * don't optimize not([lten,gten]) for setdefs
  861. Revision 1.39 2002/08/25 09:10:58 peter
  862. * fixed not(not()) removal
  863. Revision 1.38 2002/08/15 15:09:42 carl
  864. + fpu emulation helpers (ppu checking also)
  865. Revision 1.37 2002/08/14 19:26:55 carl
  866. + generic int_to_real type conversion
  867. + generic unaryminus node
  868. Revision 1.36 2002/07/20 11:57:54 florian
  869. * types.pas renamed to defbase.pas because D6 contains a types
  870. unit so this would conflicts if D6 programms are compiled
  871. + Willamette/SSE2 instructions to assembler added
  872. Revision 1.35 2002/07/19 11:41:36 daniel
  873. * State tracker work
  874. * The whilen and repeatn are now completely unified into whilerepeatn. This
  875. allows the state tracker to change while nodes automatically into
  876. repeat nodes.
  877. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  878. 'not(a>b)' is optimized into 'a<=b'.
  879. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  880. by removing the notn and later switchting the true and falselabels. The
  881. same is done with 'repeat until not a'.
  882. Revision 1.34 2002/05/18 13:34:10 peter
  883. * readded missing revisions
  884. Revision 1.33 2002/05/16 19:46:39 carl
  885. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  886. + try to fix temp allocation (still in ifdef)
  887. + generic constructor calls
  888. + start of tassembler / tmodulebase class cleanup
  889. Revision 1.31 2002/04/07 13:26:10 carl
  890. + change unit use
  891. Revision 1.30 2002/04/02 17:11:29 peter
  892. * tlocation,treference update
  893. * LOC_CONSTANT added for better constant handling
  894. * secondadd splitted in multiple routines
  895. * location_force_reg added for loading a location to a register
  896. of a specified size
  897. * secondassignment parses now first the right and then the left node
  898. (this is compatible with Kylix). This saves a lot of push/pop especially
  899. with string operations
  900. * adapted some routines to use the new cg methods
  901. Revision 1.29 2002/03/04 19:10:11 peter
  902. * removed compiler warnings
  903. Revision 1.28 2002/02/11 11:45:51 michael
  904. * Compilation without mmx support fixed from Peter
  905. }