nmat.pas 32 KB

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