nmat.pas 32 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009
  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,tokens,
  73. verbose,globals,cutils,
  74. globtype,
  75. symconst,symtype,symtable,symdef,symsym,defutil,
  76. htypechk,pass_1,cpubase,
  77. cgbase,procinfo,
  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. inserttypeconv(left,right.resulttype)
  151. else
  152. if (ld.typ in [u32bit,u64bit]) and
  153. is_constintnode(right) and
  154. (tordconstnode(right).value >= 0) then
  155. inserttypeconv(right,left.resulttype);
  156. { when there is one currency value, everything is done
  157. using currency }
  158. if (ld.typ=scurrency) or
  159. (rd.typ=scurrency) then
  160. begin
  161. if (ld.typ<>scurrency) then
  162. inserttypeconv(left,s64currencytype);
  163. if (rd.typ<>scurrency) then
  164. inserttypeconv(right,s64currencytype);
  165. resulttype:=left.resulttype;
  166. end
  167. else
  168. {$ifndef cpu64bit}
  169. { when there is one 64bit value, everything is done
  170. in 64bit }
  171. if (is_64bitint(left.resulttype.def) or
  172. is_64bitint(right.resulttype.def)) then
  173. begin
  174. if is_signed(rd) or is_signed(ld) then
  175. begin
  176. if (torddef(ld).typ<>s64bit) then
  177. inserttypeconv(left,s64inttype);
  178. if (torddef(rd).typ<>s64bit) then
  179. inserttypeconv(right,s64inttype);
  180. end
  181. else
  182. begin
  183. if (torddef(ld).typ<>u64bit) then
  184. inserttypeconv(left,u64inttype);
  185. if (torddef(rd).typ<>u64bit) then
  186. inserttypeconv(right,u64inttype);
  187. end;
  188. resulttype:=left.resulttype;
  189. end
  190. else
  191. { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
  192. if ((rd.typ = u32bit) and
  193. is_signed(left.resulttype.def)) or
  194. ((ld.typ = u32bit) and
  195. is_signed(right.resulttype.def)) then
  196. begin
  197. CGMessage(type_w_mixed_signed_unsigned);
  198. if (torddef(ld).typ<>s64bit) then
  199. inserttypeconv(left,s64inttype);
  200. if (torddef(rd).typ<>s64bit) then
  201. inserttypeconv(right,s64inttype);
  202. resulttype:=left.resulttype;
  203. end
  204. else
  205. {$endif cpu64bit}
  206. begin
  207. { Make everything always default singed int }
  208. if not(torddef(right.resulttype.def).typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  209. inserttypeconv(right,sinttype);
  210. if not(torddef(left.resulttype.def).typ in [torddef(sinttype.def).typ,torddef(uinttype.def).typ]) then
  211. inserttypeconv(left,sinttype);
  212. resulttype:=right.resulttype;
  213. end;
  214. { when the result is currency we need some extra code for
  215. division. this should not be done when the divn node is
  216. created internally }
  217. if (nodetype=divn) and
  218. not(nf_is_currency in flags) and
  219. is_currency(resulttype.def) then
  220. begin
  221. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  222. include(hp.flags,nf_is_currency);
  223. result:=hp;
  224. end;
  225. end;
  226. function tmoddivnode.first_moddivint: tnode;
  227. {$ifdef cpuneedsdiv32helper}
  228. var
  229. procname: string[31];
  230. begin
  231. result := nil;
  232. { otherwise create a call to a helper }
  233. if nodetype = divn then
  234. procname := 'fpc_div_'
  235. else
  236. procname := 'fpc_mod_';
  237. { only qword needs the unsigned code, the
  238. signed code is also used for currency }
  239. if is_signed(resulttype.def) then
  240. procname := procname + 'longint'
  241. else
  242. procname := procname + 'dword';
  243. result := ccallnode.createintern(procname,ccallparanode.create(left,
  244. ccallparanode.create(right,nil)));
  245. left := nil;
  246. right := nil;
  247. firstpass(result);
  248. end;
  249. {$else cpuneedsdiv32helper}
  250. begin
  251. result:=nil;
  252. end;
  253. {$endif cpuneedsdiv32helper}
  254. {$ifndef cpu64bit}
  255. function tmoddivnode.first_moddiv64bitint: tnode;
  256. var
  257. procname: string[31];
  258. begin
  259. result := nil;
  260. { when currency is used set the result of the
  261. parameters to s64bit, so they are not converted }
  262. if is_currency(resulttype.def) then
  263. begin
  264. left.resulttype:=s64inttype;
  265. right.resulttype:=s64inttype;
  266. end;
  267. { otherwise create a call to a helper }
  268. if nodetype = divn then
  269. procname := 'fpc_div_'
  270. else
  271. procname := 'fpc_mod_';
  272. { only qword needs the unsigned code, the
  273. signed code is also used for currency }
  274. if is_signed(resulttype.def) then
  275. procname := procname + 'int64'
  276. else
  277. procname := procname + 'qword';
  278. result := ccallnode.createintern(procname,ccallparanode.create(left,
  279. ccallparanode.create(right,nil)));
  280. left := nil;
  281. right := nil;
  282. firstpass(result);
  283. end;
  284. {$endif cpu64bit}
  285. function tmoddivnode.firstoptimize: tnode;
  286. var
  287. power{,shiftval} : longint;
  288. newtype: tnodetype;
  289. begin
  290. result := nil;
  291. { divide/mod a number by a constant which is a power of 2? }
  292. if (cs_optimize in aktglobalswitches) and
  293. (right.nodetype = ordconstn) and
  294. { ((nodetype = divn) or
  295. not is_signed(resulttype.def)) and}
  296. (not is_signed(resulttype.def)) and
  297. ispowerof2(tordconstnode(right).value,power) then
  298. begin
  299. if nodetype = divn then
  300. begin
  301. (*
  302. if is_signed(resulttype.def) then
  303. begin
  304. if is_64bitint(left.resulttype.def) then
  305. if not (cs_littlesize in aktglobalswitches) then
  306. shiftval := 63
  307. else
  308. { the shift code is a lot bigger than the call to }
  309. { the divide helper }
  310. exit
  311. else
  312. shiftval := 31;
  313. { we reuse left twice, so create once a copy of it }
  314. { !!! if left is a call is -> call gets executed twice }
  315. left := caddnode.create(addn,left,
  316. caddnode.create(andn,
  317. cshlshrnode.create(sarn,left.getcopy,
  318. cordconstnode.create(shiftval,sinttype,false)),
  319. cordconstnode.create(tordconstnode(right).value-1,
  320. right.resulttype,false)));
  321. newtype := sarn;
  322. end
  323. else
  324. *)
  325. newtype := shrn;
  326. tordconstnode(right).value := power;
  327. result := cshlshrnode.create(newtype,left,right)
  328. end
  329. else
  330. begin
  331. dec(tordconstnode(right).value);
  332. result := caddnode.create(andn,left,right);
  333. end;
  334. { left and right are reused }
  335. left := nil;
  336. right := nil;
  337. firstpass(result);
  338. exit;
  339. end;
  340. end;
  341. function tmoddivnode.pass_1 : tnode;
  342. begin
  343. result:=nil;
  344. firstpass(left);
  345. firstpass(right);
  346. if codegenerror then
  347. exit;
  348. { Try to optimize mod/div }
  349. result := firstoptimize;
  350. if assigned(result) then
  351. exit;
  352. {$ifndef cpu64bit}
  353. { 64bit }
  354. if (left.resulttype.def.deftype=orddef) and
  355. (right.resulttype.def.deftype=orddef) and
  356. (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
  357. begin
  358. result := first_moddiv64bitint;
  359. if assigned(result) then
  360. exit;
  361. expectloc:=LOC_REGISTER;
  362. calcregisters(self,2,0,0);
  363. end
  364. else
  365. {$endif cpu64bit}
  366. begin
  367. result := first_moddivint;
  368. if assigned(result) then
  369. exit;
  370. left_right_max;
  371. if left.registersint<=right.registersint then
  372. inc(registersint);
  373. end;
  374. expectloc:=LOC_REGISTER;
  375. end;
  376. {****************************************************************************
  377. TSHLSHRNODE
  378. ****************************************************************************}
  379. function tshlshrnode.det_resulttype:tnode;
  380. var
  381. t : tnode;
  382. begin
  383. result:=nil;
  384. resulttypepass(left);
  385. resulttypepass(right);
  386. set_varstate(right,vs_used,true);
  387. set_varstate(left,vs_used,true);
  388. if codegenerror then
  389. exit;
  390. { constant folding }
  391. if is_constintnode(left) and is_constintnode(right) then
  392. begin
  393. case nodetype of
  394. shrn:
  395. t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
  396. shln:
  397. t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
  398. end;
  399. result:=t;
  400. exit;
  401. end;
  402. { allow operator overloading }
  403. t:=self;
  404. if isbinaryoverloaded(t) then
  405. begin
  406. result:=t;
  407. exit;
  408. end;
  409. {$ifndef cpu64bit}
  410. { 64 bit ints have their own shift handling }
  411. if not is_64bit(left.resulttype.def) then
  412. {$endif cpu64bit}
  413. begin
  414. if torddef(left.resulttype.def).typ<>torddef(uinttype.def).typ then
  415. inserttypeconv(left,sinttype);
  416. end;
  417. inserttypeconv(right,sinttype);
  418. resulttype:=left.resulttype;
  419. end;
  420. {$ifndef cpu64bit}
  421. function tshlshrnode.first_shlshr64bitint: tnode;
  422. var
  423. procname: string[31];
  424. begin
  425. result := nil;
  426. { otherwise create a call to a helper }
  427. if nodetype = shln then
  428. procname := 'fpc_shl_int64'
  429. else
  430. procname := 'fpc_shr_int64';
  431. { this order of parameters works at least for the arm,
  432. however it should work for any calling conventions (FK) }
  433. result := ccallnode.createintern(procname,ccallparanode.create(right,
  434. ccallparanode.create(left,nil)));
  435. left := nil;
  436. right := nil;
  437. firstpass(result);
  438. end;
  439. {$endif cpu64bit}
  440. function tshlshrnode.pass_1 : tnode;
  441. var
  442. regs : longint;
  443. begin
  444. result:=nil;
  445. firstpass(left);
  446. firstpass(right);
  447. if codegenerror then
  448. exit;
  449. {$ifndef cpu64bit}
  450. { 64 bit ints have their own shift handling }
  451. if is_64bit(left.resulttype.def) then
  452. begin
  453. result := first_shlshr64bitint;
  454. if assigned(result) then
  455. exit;
  456. regs:=2;
  457. end
  458. else
  459. {$endif cpu64bit}
  460. begin
  461. regs:=1
  462. end;
  463. if (right.nodetype<>ordconstn) then
  464. inc(regs);
  465. expectloc:=LOC_REGISTER;
  466. calcregisters(self,regs,0,0);
  467. end;
  468. {****************************************************************************
  469. TUNARYMINUSNODE
  470. ****************************************************************************}
  471. constructor tunaryminusnode.create(expr : tnode);
  472. begin
  473. inherited create(unaryminusn,expr);
  474. end;
  475. function tunaryminusnode.det_resulttype : tnode;
  476. var
  477. t : tnode;
  478. minusdef : Tprocdef;
  479. begin
  480. result:=nil;
  481. resulttypepass(left);
  482. set_varstate(left,vs_used,true);
  483. if codegenerror then
  484. exit;
  485. { constant folding }
  486. if is_constintnode(left) then
  487. begin
  488. tordconstnode(left).value:=-tordconstnode(left).value;
  489. result:=left;
  490. left:=nil;
  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. notdef : Tprocdef;
  602. v : tconstexprint;
  603. begin
  604. result:=nil;
  605. resulttypepass(left);
  606. set_varstate(left,vs_used,true);
  607. if codegenerror then
  608. exit;
  609. resulttype:=left.resulttype;
  610. { Try optmimizing ourself away }
  611. if left.nodetype=notn then
  612. begin
  613. { Double not. Remove both }
  614. result:=Tnotnode(left).left;
  615. Tnotnode(left).left:=nil;
  616. exit;
  617. end;
  618. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  619. begin
  620. { Not of boolean expression. Turn around the operator and remove
  621. the not. This is not allowed for sets with the gten/lten,
  622. because there is no ltn/gtn support }
  623. if (taddnode(left).left.resulttype.def.deftype<>setdef) or
  624. (left.nodetype in [equaln,unequaln]) then
  625. begin
  626. result:=left;
  627. left.nodetype:=boolean_reverse[left.nodetype];
  628. left:=nil;
  629. exit;
  630. end;
  631. end;
  632. { constant folding }
  633. if (left.nodetype=ordconstn) then
  634. begin
  635. v:=tordconstnode(left).value;
  636. tt:=left.resulttype;
  637. case torddef(left.resulttype.def).typ of
  638. bool8bit,
  639. bool16bit,
  640. bool32bit :
  641. begin
  642. { here we do a boolean(byte(..)) type cast because }
  643. { boolean(<int64>) is buggy in 1.00 }
  644. v:=byte(not(boolean(byte(v))));
  645. end;
  646. uchar,
  647. uwidechar,
  648. u8bit,
  649. s8bit,
  650. u16bit,
  651. s16bit,
  652. u32bit,
  653. s32bit,
  654. s64bit,
  655. u64bit :
  656. begin
  657. v:=int64(not int64(v)); { maybe qword is required }
  658. int_to_type(v,tt);
  659. end;
  660. else
  661. CGMessage(type_e_mismatch);
  662. end;
  663. t:=cordconstnode.create(v,tt,true);
  664. result:=t;
  665. exit;
  666. end;
  667. if is_boolean(resulttype.def) then
  668. begin
  669. end
  670. else
  671. {$ifdef SUPPORT_MMX}
  672. if (cs_mmx in aktlocalswitches) and
  673. is_mmx_able_array(left.resulttype.def) then
  674. begin
  675. end
  676. else
  677. {$endif SUPPORT_MMX}
  678. {$ifndef cpu64bit}
  679. if is_64bitint(left.resulttype.def) then
  680. begin
  681. end
  682. else
  683. {$endif cpu64bit}
  684. if is_integer(left.resulttype.def) then
  685. begin
  686. end
  687. else
  688. begin
  689. { allow operator overloading }
  690. t:=self;
  691. if isunaryoverloaded(t) then
  692. begin
  693. result:=t;
  694. exit;
  695. end;
  696. CGMessage(type_e_mismatch);
  697. end;
  698. end;
  699. function tnotnode.pass_1 : tnode;
  700. begin
  701. result:=nil;
  702. firstpass(left);
  703. if codegenerror then
  704. exit;
  705. expectloc:=left.expectloc;
  706. registersint:=left.registersint;
  707. {$ifdef SUPPORT_MMX}
  708. registersmmx:=left.registersmmx;
  709. {$endif SUPPORT_MMX}
  710. if is_boolean(resulttype.def) then
  711. begin
  712. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  713. begin
  714. expectloc:=LOC_REGISTER;
  715. if (registersint<1) then
  716. registersint:=1;
  717. end;
  718. { before loading it into flags we need to load it into
  719. a register thus 1 register is need PM }
  720. {$ifdef cpuflags}
  721. if left.expectloc<>LOC_JUMP then
  722. expectloc:=LOC_FLAGS;
  723. {$endif def cpuflags}
  724. end
  725. else
  726. {$ifdef SUPPORT_MMX}
  727. if (cs_mmx in aktlocalswitches) and
  728. is_mmx_able_array(left.resulttype.def) then
  729. begin
  730. if (left.expectloc<>LOC_MMXREGISTER) and
  731. (registersmmx<1) then
  732. registersmmx:=1;
  733. end
  734. else
  735. {$endif SUPPORT_MMX}
  736. {$ifndef cpu64bit}
  737. if is_64bit(left.resulttype.def) then
  738. begin
  739. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  740. begin
  741. expectloc:=LOC_REGISTER;
  742. if (registersint<2) then
  743. registersint:=2;
  744. end;
  745. end
  746. else
  747. {$endif cpu64bit}
  748. if is_integer(left.resulttype.def) then
  749. begin
  750. if (left.expectloc<>LOC_REGISTER) and
  751. (registersint<1) then
  752. registersint:=1;
  753. expectloc:=LOC_REGISTER;
  754. end;
  755. end;
  756. {$ifdef state_tracking}
  757. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  758. begin
  759. track_state_pass:=true;
  760. if left.track_state_pass(exec_known) then
  761. begin
  762. left.resulttype.def:=nil;
  763. do_resulttypepass(left);
  764. end;
  765. end;
  766. {$endif}
  767. begin
  768. cmoddivnode:=tmoddivnode;
  769. cshlshrnode:=tshlshrnode;
  770. cunaryminusnode:=tunaryminusnode;
  771. cnotnode:=tnotnode;
  772. end.
  773. {
  774. $Log$
  775. Revision 1.60 2004-03-23 22:34:49 peter
  776. * constants ordinals now always have a type assigned
  777. * integer constants have the smallest type, unsigned prefered over
  778. signed
  779. Revision 1.59 2004/02/24 16:12:39 peter
  780. * operator overload chooses rewrite
  781. * overload choosing is now generic and moved to htypechk
  782. Revision 1.58 2004/02/04 22:15:15 daniel
  783. * Rtti generation moved to ncgutil
  784. * Assmtai usage of symsym removed
  785. * operator overloading cleanup up
  786. Revision 1.57 2004/02/04 19:22:27 peter
  787. *** empty log message ***
  788. Revision 1.56 2004/02/03 22:32:54 peter
  789. * renamed xNNbittype to xNNinttype
  790. * renamed registers32 to registersint
  791. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  792. Revision 1.55 2004/01/23 15:12:49 florian
  793. * fixed generic shl/shr operations
  794. + added register allocation hook calls for arm specific operand types:
  795. register set and shifter op
  796. Revision 1.54 2003/12/09 21:17:04 jonas
  797. + support for evaluating qword constant expressions (both arguments have
  798. to be a qword, constants have to be explicitly typecasted to qword)
  799. Revision 1.53 2003/10/08 19:19:45 peter
  800. * set_varstate cleanup
  801. Revision 1.52 2003/10/01 20:34:49 peter
  802. * procinfo unit contains tprocinfo
  803. * cginfo renamed to cgbase
  804. * moved cgmessage to verbose
  805. * fixed ppc and sparc compiles
  806. Revision 1.51 2003/09/07 22:09:35 peter
  807. * preparations for different default calling conventions
  808. * various RA fixes
  809. Revision 1.50 2003/09/03 11:18:37 florian
  810. * fixed arm concatcopy
  811. + arm support in the common compiler sources added
  812. * moved some generic cg code around
  813. + tfputype added
  814. * ...
  815. Revision 1.49 2003/05/24 16:32:34 jonas
  816. * fixed expectloc of notnode for all processors that have flags
  817. Revision 1.48 2003/05/09 17:47:02 peter
  818. * self moved to hidden parameter
  819. * removed hdisposen,hnewn,selfn
  820. Revision 1.47 2003/04/25 20:59:33 peter
  821. * removed funcretn,funcretsym, function result is now in varsym
  822. and aliases for result and function name are added using absolutesym
  823. * vs_hidden parameter for funcret passed in parameter
  824. * vs_hidden fixes
  825. * writenode changed to printnode and released from extdebug
  826. * -vp option added to generate a tree.log with the nodetree
  827. * nicer printnode for statements, callnode
  828. Revision 1.46 2003/04/23 20:16:04 peter
  829. + added currency support based on int64
  830. + is_64bit for use in cg units instead of is_64bitint
  831. * removed cgmessage from n386add, replace with internalerrors
  832. Revision 1.45 2003/04/22 23:50:23 peter
  833. * firstpass uses expectloc
  834. * checks if there are differences between the expectloc and
  835. location.loc from secondpass in EXTDEBUG
  836. Revision 1.44 2002/11/25 17:43:20 peter
  837. * splitted defbase in defutil,symutil,defcmp
  838. * merged isconvertable and is_equal into compare_defs(_ext)
  839. * made operator search faster by walking the list only once
  840. Revision 1.43 2002/10/04 21:19:28 jonas
  841. * fixed web bug 2139: checking for division by zero fixed
  842. Revision 1.42 2002/09/07 12:16:04 carl
  843. * second part bug report 1996 fix, testrange in cordconstnode
  844. only called if option is set (also make parsing a tiny faster)
  845. Revision 1.41 2002/09/03 16:26:26 daniel
  846. * Make Tprocdef.defs protected
  847. Revision 1.40 2002/08/25 11:32:33 peter
  848. * don't optimize not([lten,gten]) for setdefs
  849. Revision 1.39 2002/08/25 09:10:58 peter
  850. * fixed not(not()) removal
  851. Revision 1.38 2002/08/15 15:09:42 carl
  852. + fpu emulation helpers (ppu checking also)
  853. Revision 1.37 2002/08/14 19:26:55 carl
  854. + generic int_to_real type conversion
  855. + generic unaryminus node
  856. Revision 1.36 2002/07/20 11:57:54 florian
  857. * types.pas renamed to defbase.pas because D6 contains a types
  858. unit so this would conflicts if D6 programms are compiled
  859. + Willamette/SSE2 instructions to assembler added
  860. Revision 1.35 2002/07/19 11:41:36 daniel
  861. * State tracker work
  862. * The whilen and repeatn are now completely unified into whilerepeatn. This
  863. allows the state tracker to change while nodes automatically into
  864. repeat nodes.
  865. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  866. 'not(a>b)' is optimized into 'a<=b'.
  867. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  868. by removing the notn and later switchting the true and falselabels. The
  869. same is done with 'repeat until not a'.
  870. Revision 1.34 2002/05/18 13:34:10 peter
  871. * readded missing revisions
  872. Revision 1.33 2002/05/16 19:46:39 carl
  873. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  874. + try to fix temp allocation (still in ifdef)
  875. + generic constructor calls
  876. + start of tassembler / tmodulebase class cleanup
  877. Revision 1.31 2002/04/07 13:26:10 carl
  878. + change unit use
  879. Revision 1.30 2002/04/02 17:11:29 peter
  880. * tlocation,treference update
  881. * LOC_CONSTANT added for better constant handling
  882. * secondadd splitted in multiple routines
  883. * location_force_reg added for loading a location to a register
  884. of a specified size
  885. * secondassignment parses now first the right and then the left node
  886. (this is compatible with Kylix). This saves a lot of push/pop especially
  887. with string operations
  888. * adapted some routines to use the new cg methods
  889. Revision 1.29 2002/03/04 19:10:11 peter
  890. * removed compiler warnings
  891. Revision 1.28 2002/02/11 11:45:51 michael
  892. * Compilation without mmx support fixed from Peter
  893. }