nmat.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888
  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 minusdef<>nil then
  476. begin
  477. t:=ccallnode.create(ccallparanode.create(left,nil),
  478. overloaded_operators[_minus],nil,nil);
  479. left:=nil;
  480. result:=t;
  481. exit;
  482. end;
  483. CGMessage(type_e_mismatch);
  484. end;
  485. end;
  486. { generic code }
  487. { overridden by: }
  488. { i386 }
  489. function tunaryminusnode.pass_1 : tnode;
  490. begin
  491. result:=nil;
  492. firstpass(left);
  493. if codegenerror then
  494. exit;
  495. registers32:=left.registers32;
  496. registersfpu:=left.registersfpu;
  497. {$ifdef SUPPORT_MMX}
  498. registersmmx:=left.registersmmx;
  499. {$endif SUPPORT_MMX}
  500. if (left.resulttype.def.deftype=floatdef) then
  501. begin
  502. if (left.expectloc<>LOC_REGISTER) and
  503. (registersfpu<1) then
  504. registersfpu:=1;
  505. expectloc:=LOC_FPUREGISTER;
  506. end
  507. {$ifdef SUPPORT_MMX}
  508. else if (cs_mmx in aktlocalswitches) and
  509. is_mmx_able_array(left.resulttype.def) then
  510. begin
  511. if (left.expectloc<>LOC_MMXREGISTER) and
  512. (registersmmx<1) then
  513. registersmmx:=1;
  514. end
  515. {$endif SUPPORT_MMX}
  516. else if is_64bit(left.resulttype.def) then
  517. begin
  518. if (left.expectloc<>LOC_REGISTER) and
  519. (registers32<2) then
  520. registers32:=2;
  521. expectloc:=LOC_REGISTER;
  522. end
  523. else if (left.resulttype.def.deftype=orddef) then
  524. begin
  525. if (left.expectloc<>LOC_REGISTER) and
  526. (registers32<1) then
  527. registers32:=1;
  528. expectloc:=LOC_REGISTER;
  529. end;
  530. end;
  531. {****************************************************************************
  532. TNOTNODE
  533. ****************************************************************************}
  534. const boolean_reverse:array[ltn..unequaln] of Tnodetype=
  535. (gten,gtn,lten,ltn,unequaln,equaln);
  536. constructor tnotnode.create(expr : tnode);
  537. begin
  538. inherited create(notn,expr);
  539. end;
  540. function tnotnode.det_resulttype : tnode;
  541. var
  542. t : tnode;
  543. notdef : Tprocdef;
  544. v : tconstexprint;
  545. begin
  546. result:=nil;
  547. resulttypepass(left);
  548. set_varstate(left,true);
  549. if codegenerror then
  550. exit;
  551. resulttype:=left.resulttype;
  552. { Try optmimizing ourself away }
  553. if left.nodetype=notn then
  554. begin
  555. { Double not. Remove both }
  556. result:=Tnotnode(left).left;
  557. Tnotnode(left).left:=nil;
  558. exit;
  559. end;
  560. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  561. begin
  562. { Not of boolean expression. Turn around the operator and remove
  563. the not. This is not allowed for sets with the gten/lten,
  564. because there is no ltn/gtn support }
  565. if (taddnode(left).left.resulttype.def.deftype<>setdef) or
  566. (left.nodetype in [equaln,unequaln]) then
  567. begin
  568. result:=left;
  569. left.nodetype:=boolean_reverse[left.nodetype];
  570. left:=nil;
  571. exit;
  572. end;
  573. end;
  574. { constant folding }
  575. if (left.nodetype=ordconstn) then
  576. begin
  577. v:=tordconstnode(left).value;
  578. case torddef(left.resulttype.def).typ of
  579. bool8bit,
  580. bool16bit,
  581. bool32bit :
  582. begin
  583. { here we do a boolean(byte(..)) type cast because }
  584. { boolean(<int64>) is buggy in 1.00 }
  585. v:=byte(not(boolean(byte(v))));
  586. end;
  587. uchar,
  588. u8bit :
  589. v:=byte(not byte(v));
  590. s8bit :
  591. v:=shortint(not shortint(v));
  592. uwidechar,
  593. u16bit :
  594. v:=word(not word(v));
  595. s16bit :
  596. v:=smallint(not smallint(v));
  597. u32bit :
  598. v:=cardinal(not cardinal(v));
  599. s32bit :
  600. v:=longint(not longint(v));
  601. u64bit :
  602. v:=int64(not int64(v)); { maybe qword is required }
  603. s64bit :
  604. v:=int64(not int64(v));
  605. else
  606. CGMessage(type_e_mismatch);
  607. end;
  608. t:=cordconstnode.create(v,left.resulttype,true);
  609. result:=t;
  610. exit;
  611. end;
  612. if is_boolean(resulttype.def) then
  613. begin
  614. end
  615. else
  616. {$ifdef SUPPORT_MMX}
  617. if (cs_mmx in aktlocalswitches) and
  618. is_mmx_able_array(left.resulttype.def) then
  619. begin
  620. end
  621. else
  622. {$endif SUPPORT_MMX}
  623. if is_64bitint(left.resulttype.def) then
  624. begin
  625. end
  626. else if is_integer(left.resulttype.def) then
  627. begin
  628. end
  629. else
  630. begin
  631. notdef:=nil;
  632. if assigned(overloaded_operators[_op_not]) then
  633. notdef:=overloaded_operators[_op_not].search_procdef_unary_operator(left.resulttype.def);
  634. if notdef<>nil then
  635. begin
  636. t:=ccallnode.create(ccallparanode.create(left,nil),
  637. overloaded_operators[_op_not],nil,nil);
  638. left:=nil;
  639. result:=t;
  640. exit;
  641. end;
  642. CGMessage(type_e_mismatch);
  643. end;
  644. end;
  645. function tnotnode.pass_1 : tnode;
  646. begin
  647. result:=nil;
  648. firstpass(left);
  649. if codegenerror then
  650. exit;
  651. expectloc:=left.expectloc;
  652. registers32:=left.registers32;
  653. {$ifdef SUPPORT_MMX}
  654. registersmmx:=left.registersmmx;
  655. {$endif SUPPORT_MMX}
  656. if is_boolean(resulttype.def) then
  657. begin
  658. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  659. begin
  660. expectloc:=LOC_REGISTER;
  661. if (registers32<1) then
  662. registers32:=1;
  663. end;
  664. { before loading it into flags we need to load it into
  665. a register thus 1 register is need PM }
  666. {$ifdef i386}
  667. if left.expectloc<>LOC_JUMP then
  668. expectloc:=LOC_FLAGS;
  669. {$endif def i386}
  670. end
  671. else
  672. {$ifdef SUPPORT_MMX}
  673. if (cs_mmx in aktlocalswitches) and
  674. is_mmx_able_array(left.resulttype.def) then
  675. begin
  676. if (left.expectloc<>LOC_MMXREGISTER) and
  677. (registersmmx<1) then
  678. registersmmx:=1;
  679. end
  680. else
  681. {$endif SUPPORT_MMX}
  682. if is_64bit(left.resulttype.def) then
  683. begin
  684. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  685. begin
  686. expectloc:=LOC_REGISTER;
  687. if (registers32<2) then
  688. registers32:=2;
  689. end;
  690. end
  691. else if is_integer(left.resulttype.def) then
  692. begin
  693. if (left.expectloc<>LOC_REGISTER) and
  694. (registers32<1) then
  695. registers32:=1;
  696. expectloc:=LOC_REGISTER;
  697. end
  698. end;
  699. {$ifdef state_tracking}
  700. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  701. begin
  702. track_state_pass:=true;
  703. if left.track_state_pass(exec_known) then
  704. begin
  705. left.resulttype.def:=nil;
  706. do_resulttypepass(left);
  707. end;
  708. end;
  709. {$endif}
  710. begin
  711. cmoddivnode:=tmoddivnode;
  712. cshlshrnode:=tshlshrnode;
  713. cunaryminusnode:=tunaryminusnode;
  714. cnotnode:=tnotnode;
  715. end.
  716. {
  717. $Log$
  718. Revision 1.47 2003-04-25 20:59:33 peter
  719. * removed funcretn,funcretsym, function result is now in varsym
  720. and aliases for result and function name are added using absolutesym
  721. * vs_hidden parameter for funcret passed in parameter
  722. * vs_hidden fixes
  723. * writenode changed to printnode and released from extdebug
  724. * -vp option added to generate a tree.log with the nodetree
  725. * nicer printnode for statements, callnode
  726. Revision 1.46 2003/04/23 20:16:04 peter
  727. + added currency support based on int64
  728. + is_64bit for use in cg units instead of is_64bitint
  729. * removed cgmessage from n386add, replace with internalerrors
  730. Revision 1.45 2003/04/22 23:50:23 peter
  731. * firstpass uses expectloc
  732. * checks if there are differences between the expectloc and
  733. location.loc from secondpass in EXTDEBUG
  734. Revision 1.44 2002/11/25 17:43:20 peter
  735. * splitted defbase in defutil,symutil,defcmp
  736. * merged isconvertable and is_equal into compare_defs(_ext)
  737. * made operator search faster by walking the list only once
  738. Revision 1.43 2002/10/04 21:19:28 jonas
  739. * fixed web bug 2139: checking for division by zero fixed
  740. Revision 1.42 2002/09/07 12:16:04 carl
  741. * second part bug report 1996 fix, testrange in cordconstnode
  742. only called if option is set (also make parsing a tiny faster)
  743. Revision 1.41 2002/09/03 16:26:26 daniel
  744. * Make Tprocdef.defs protected
  745. Revision 1.40 2002/08/25 11:32:33 peter
  746. * don't optimize not([lten,gten]) for setdefs
  747. Revision 1.39 2002/08/25 09:10:58 peter
  748. * fixed not(not()) removal
  749. Revision 1.38 2002/08/15 15:09:42 carl
  750. + fpu emulation helpers (ppu checking also)
  751. Revision 1.37 2002/08/14 19:26:55 carl
  752. + generic int_to_real type conversion
  753. + generic unaryminus node
  754. Revision 1.36 2002/07/20 11:57:54 florian
  755. * types.pas renamed to defbase.pas because D6 contains a types
  756. unit so this would conflicts if D6 programms are compiled
  757. + Willamette/SSE2 instructions to assembler added
  758. Revision 1.35 2002/07/19 11:41:36 daniel
  759. * State tracker work
  760. * The whilen and repeatn are now completely unified into whilerepeatn. This
  761. allows the state tracker to change while nodes automatically into
  762. repeat nodes.
  763. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  764. 'not(a>b)' is optimized into 'a<=b'.
  765. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  766. by removing the notn and later switchting the true and falselabels. The
  767. same is done with 'repeat until not a'.
  768. Revision 1.34 2002/05/18 13:34:10 peter
  769. * readded missing revisions
  770. Revision 1.33 2002/05/16 19:46:39 carl
  771. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  772. + try to fix temp allocation (still in ifdef)
  773. + generic constructor calls
  774. + start of tassembler / tmodulebase class cleanup
  775. Revision 1.31 2002/04/07 13:26:10 carl
  776. + change unit use
  777. Revision 1.30 2002/04/02 17:11:29 peter
  778. * tlocation,treference update
  779. * LOC_CONSTANT added for better constant handling
  780. * secondadd splitted in multiple routines
  781. * location_force_reg added for loading a location to a register
  782. of a specified size
  783. * secondassignment parses now first the right and then the left node
  784. (this is compatible with Kylix). This saves a lot of push/pop especially
  785. with string operations
  786. * adapted some routines to use the new cg methods
  787. Revision 1.29 2002/03/04 19:10:11 peter
  788. * removed compiler warnings
  789. Revision 1.28 2002/02/11 11:45:51 michael
  790. * Compilation without mmx support fixed from Peter
  791. }