nmat.pas 29 KB

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