nmat.pas 31 KB

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