nmat.pas 32 KB

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