nmat.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104
  1. {
  2. Copyright (c) 2000-2005 by Florian Klaempfl
  3. Type checking and register allocation for math nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nmat;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node;
  22. type
  23. tmoddivnode = class(tbinopnode)
  24. function pass_1 : tnode;override;
  25. function pass_typecheck:tnode;override;
  26. function simplify(forinline : boolean) : tnode;override;
  27. protected
  28. {$ifndef cpu64bitalu}
  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 not cpu64bitalu}
  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 pass_typecheck:tnode;override;
  40. function simplify(forinline : boolean) : tnode;override;
  41. {$ifndef cpu64bitalu}
  42. { override the following if you want to implement }
  43. { parts explicitely in the code generator (CEC)
  44. Should return nil, if everything will be handled
  45. in the code generator
  46. }
  47. function first_shlshr64bitint: tnode; virtual;
  48. {$endif not cpu64bitalu}
  49. end;
  50. tshlshrnodeclass = class of tshlshrnode;
  51. tunaryminusnode = class(tunarynode)
  52. constructor create(expr : tnode);virtual;
  53. function pass_1 : tnode;override;
  54. function pass_typecheck:tnode;override;
  55. function simplify(forinline : boolean) : tnode;override;
  56. end;
  57. tunaryminusnodeclass = class of tunaryminusnode;
  58. tunaryplusnode = class(tunarynode)
  59. constructor create(expr : tnode);virtual;
  60. function pass_1 : tnode;override;
  61. function pass_typecheck:tnode;override;
  62. end;
  63. tunaryplusnodeclass = class of tunaryplusnode;
  64. tnotnode = class(tunarynode)
  65. constructor create(expr : tnode);virtual;
  66. function pass_1 : tnode;override;
  67. function pass_typecheck:tnode;override;
  68. function simplify(forinline : boolean) : tnode;override;
  69. {$ifdef state_tracking}
  70. function track_state_pass(exec_known:boolean):boolean;override;
  71. {$endif}
  72. end;
  73. tnotnodeclass = class of tnotnode;
  74. var
  75. cmoddivnode : tmoddivnodeclass = tmoddivnode;
  76. cshlshrnode : tshlshrnodeclass = tshlshrnode;
  77. cunaryminusnode : tunaryminusnodeclass = tunaryminusnode;
  78. cunaryplusnode : tunaryplusnodeclass = tunaryplusnode;
  79. cnotnode : tnotnodeclass = tnotnode;
  80. implementation
  81. uses
  82. systems,
  83. verbose,globals,cutils,
  84. globtype,constexp,
  85. symconst,symtype,symdef,symtable,
  86. defutil,
  87. htypechk,pass_1,
  88. cgbase,
  89. ncon,ncnv,ncal,nadd,nld,nbas,nflw,
  90. nutils;
  91. {****************************************************************************
  92. TMODDIVNODE
  93. ****************************************************************************}
  94. function tmoddivnode.simplify(forinline : boolean):tnode;
  95. var
  96. rv,lv : tconstexprint;
  97. begin
  98. result:=nil;
  99. if is_constintnode(right) then
  100. begin
  101. rv:=tordconstnode(right).value;
  102. if rv = 1 then
  103. begin
  104. case nodetype of
  105. modn:
  106. result := cordconstnode.create(0,left.resultdef,true);
  107. divn:
  108. result := left.getcopy;
  109. end;
  110. exit;
  111. end;
  112. if rv = 0 then
  113. begin
  114. Message(parser_e_division_by_zero);
  115. { recover }
  116. tordconstnode(right).value := 1;
  117. end;
  118. if (nf_isomod in flags) and
  119. (rv<=0) then
  120. begin
  121. Message(cg_e_mod_only_defined_for_pos_quotient);
  122. { recover }
  123. tordconstnode(right).value := 1;
  124. end;
  125. end;
  126. if is_constintnode(right) and is_constintnode(left) then
  127. begin
  128. rv:=tordconstnode(right).value;
  129. lv:=tordconstnode(left).value;
  130. case nodetype of
  131. modn:
  132. if nf_isomod in flags then
  133. begin
  134. if lv>=0 then
  135. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline)
  136. else
  137. if ((-lv) mod rv)=0 then
  138. result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline)
  139. else
  140. result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline);
  141. end
  142. else
  143. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
  144. divn:
  145. result:=create_simplified_ord_const(lv div rv,resultdef,forinline);
  146. end;
  147. end;
  148. end;
  149. function tmoddivnode.pass_typecheck:tnode;
  150. var
  151. else_block,
  152. hp,t : tnode;
  153. rd,ld : torddef;
  154. else_statements,
  155. statements : tstatementnode;
  156. result_data : ttempcreatenode;
  157. begin
  158. result:=nil;
  159. typecheckpass(left);
  160. typecheckpass(right);
  161. set_varstate(left,vs_read,[vsf_must_be_valid]);
  162. set_varstate(right,vs_read,[vsf_must_be_valid]);
  163. if codegenerror then
  164. exit;
  165. { tp procvar support }
  166. maybe_call_procvar(left,true);
  167. maybe_call_procvar(right,true);
  168. result:=simplify(false);
  169. if assigned(result) then
  170. exit;
  171. { allow operator overloading }
  172. t:=self;
  173. if isbinaryoverloaded(t) then
  174. begin
  175. result:=t;
  176. exit;
  177. end;
  178. { we need 2 orddefs always }
  179. if (left.resultdef.typ<>orddef) then
  180. inserttypeconv(right,sinttype);
  181. if (right.resultdef.typ<>orddef) then
  182. inserttypeconv(right,sinttype);
  183. if codegenerror then
  184. exit;
  185. rd:=torddef(right.resultdef);
  186. ld:=torddef(left.resultdef);
  187. { if one operand is a cardinal and the other is a positive constant, convert the }
  188. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  189. { Do the same for qwords and positive constants as well, otherwise things like }
  190. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  191. { "qword" was > high(int64) (JM) }
  192. { Additionally, do the same for cardinal/qwords and other positive types, but }
  193. { always in a way that a smaller type is converted to a bigger type }
  194. { (webtbs/tw8870) }
  195. if (rd.ordtype in [u32bit,u64bit]) and
  196. ((is_constintnode(left) and
  197. (tordconstnode(left).value >= 0)) or
  198. (not is_signed(ld) and
  199. (rd.size >= ld.size))) then
  200. begin
  201. inserttypeconv(left,right.resultdef);
  202. ld:=torddef(left.resultdef);
  203. end;
  204. if (ld.ordtype in [u32bit,u64bit]) and
  205. ((is_constintnode(right) and
  206. (tordconstnode(right).value >= 0)) or
  207. (not is_signed(rd) and
  208. (ld.size >= rd.size))) then
  209. begin
  210. inserttypeconv(right,left.resultdef);
  211. rd:=torddef(right.resultdef);
  212. end;
  213. { when there is one currency value, everything is done
  214. using currency }
  215. if (ld.ordtype=scurrency) or
  216. (rd.ordtype=scurrency) then
  217. begin
  218. if (ld.ordtype<>scurrency) then
  219. inserttypeconv(left,s64currencytype);
  220. if (rd.ordtype<>scurrency) then
  221. inserttypeconv(right,s64currencytype);
  222. resultdef:=left.resultdef;
  223. end
  224. else
  225. {$ifndef cpu64bitaddr}
  226. { when there is one 64bit value, everything is done
  227. in 64bit }
  228. if (is_64bitint(left.resultdef) or
  229. is_64bitint(right.resultdef)) then
  230. begin
  231. if is_signed(rd) or is_signed(ld) then
  232. begin
  233. if (ld.ordtype<>s64bit) then
  234. inserttypeconv(left,s64inttype);
  235. if (rd.ordtype<>s64bit) then
  236. inserttypeconv(right,s64inttype);
  237. end
  238. else
  239. begin
  240. if (ld.ordtype<>u64bit) then
  241. inserttypeconv(left,u64inttype);
  242. if (rd.ordtype<>u64bit) then
  243. inserttypeconv(right,u64inttype);
  244. end;
  245. resultdef:=left.resultdef;
  246. end
  247. else
  248. { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
  249. if ((rd.ordtype = u32bit) and
  250. is_signed(ld)) or
  251. ((ld.ordtype = u32bit) and
  252. is_signed(rd)) then
  253. begin
  254. CGMessage(type_h_mixed_signed_unsigned);
  255. if (ld.ordtype<>s64bit) then
  256. inserttypeconv(left,s64inttype);
  257. if (rd.ordtype<>s64bit) then
  258. inserttypeconv(right,s64inttype);
  259. resultdef:=left.resultdef;
  260. end
  261. else
  262. {$endif not cpu64bitaddr}
  263. begin
  264. { Make everything always default singed int }
  265. if not(rd.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  266. inserttypeconv(right,sinttype);
  267. if not(ld.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  268. inserttypeconv(left,sinttype);
  269. resultdef:=right.resultdef;
  270. end;
  271. { when the result is currency we need some extra code for
  272. division. this should not be done when the divn node is
  273. created internally }
  274. if (nodetype=divn) and
  275. not(nf_is_currency in flags) and
  276. is_currency(resultdef) then
  277. begin
  278. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  279. include(hp.flags,nf_is_currency);
  280. result:=hp;
  281. end;
  282. if (nodetype=modn) and (nf_isomod in flags) then
  283. begin
  284. result:=internalstatements(statements);
  285. else_block:=internalstatements(else_statements);
  286. result_data:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  287. { right <=0? }
  288. addstatement(statements,cifnode.create(caddnode.create(lten,right.getcopy,cordconstnode.create(0,resultdef,false)),
  289. { then: result:=left mod right }
  290. ccallnode.createintern('fpc_divbyzero',nil),
  291. nil
  292. ));
  293. { prepare else block }
  294. { result:=(-left) mod right }
  295. addstatement(else_statements,cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,cunaryminusnode.create(left.getcopy),right.getcopy)));
  296. { result<>0? }
  297. addstatement(else_statements,cifnode.create(caddnode.create(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)),
  298. { then: result:=right-result }
  299. cassignmentnode.create(ctemprefnode.create(result_data),caddnode.create(subn,right.getcopy,ctemprefnode.create(result_data))),
  300. nil
  301. ));
  302. addstatement(statements,result_data);
  303. { if left>=0 }
  304. addstatement(statements,cifnode.create(caddnode.create(gten,left.getcopy,cordconstnode.create(0,resultdef,false)),
  305. { then: result:=left mod right }
  306. cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,left.getcopy,right.getcopy)),
  307. { else block }
  308. else_block
  309. ));
  310. addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
  311. addstatement(statements,ctemprefnode.create(result_data));
  312. end;
  313. end;
  314. function tmoddivnode.first_moddivint: tnode;
  315. {$ifdef cpuneedsdiv32helper}
  316. var
  317. procname: string[31];
  318. begin
  319. result := nil;
  320. { otherwise create a call to a helper }
  321. if nodetype = divn then
  322. procname := 'fpc_div_'
  323. else
  324. procname := 'fpc_mod_';
  325. { only qword needs the unsigned code, the
  326. signed code is also used for currency }
  327. if is_signed(resultdef) then
  328. procname := procname + 'longint'
  329. else
  330. procname := procname + 'dword';
  331. result := ccallnode.createintern(procname,ccallparanode.create(left,
  332. ccallparanode.create(right,nil)));
  333. left := nil;
  334. right := nil;
  335. firstpass(result);
  336. end;
  337. {$else cpuneedsdiv32helper}
  338. begin
  339. result:=nil;
  340. end;
  341. {$endif cpuneedsdiv32helper}
  342. {$ifndef cpu64bitalu}
  343. function tmoddivnode.first_moddiv64bitint: tnode;
  344. var
  345. procname: string[31];
  346. begin
  347. result := nil;
  348. { when currency is used set the result of the
  349. parameters to s64bit, so they are not converted }
  350. if is_currency(resultdef) then
  351. begin
  352. left.resultdef:=s64inttype;
  353. right.resultdef:=s64inttype;
  354. end;
  355. { otherwise create a call to a helper }
  356. if nodetype = divn then
  357. procname := 'fpc_div_'
  358. else
  359. procname := 'fpc_mod_';
  360. { only qword needs the unsigned code, the
  361. signed code is also used for currency }
  362. if is_signed(resultdef) then
  363. procname := procname + 'int64'
  364. else
  365. procname := procname + 'qword';
  366. result := ccallnode.createintern(procname,ccallparanode.create(left,
  367. ccallparanode.create(right,nil)));
  368. left := nil;
  369. right := nil;
  370. firstpass(result);
  371. end;
  372. {$endif not cpu64bitalu}
  373. function tmoddivnode.firstoptimize: tnode;
  374. var
  375. power{,shiftval} : longint;
  376. newtype: tnodetype;
  377. begin
  378. result := nil;
  379. { divide/mod a number by a constant which is a power of 2? }
  380. if (cs_opt_peephole in current_settings.optimizerswitches) and
  381. (right.nodetype = ordconstn) and
  382. { ((nodetype = divn) or
  383. not is_signed(resultdef)) and}
  384. (not is_signed(resultdef)) and
  385. ispowerof2(tordconstnode(right).value,power) then
  386. begin
  387. if nodetype = divn then
  388. begin
  389. (*
  390. if is_signed(resultdef) then
  391. begin
  392. if is_64bitint(left.resultdef) then
  393. if not (cs_opt_size in current_settings.optimizerswitches) then
  394. shiftval := 63
  395. else
  396. { the shift code is a lot bigger than the call to }
  397. { the divide helper }
  398. exit
  399. else
  400. shiftval := 31;
  401. { we reuse left twice, so create once a copy of it }
  402. { !!! if left is a call is -> call gets executed twice }
  403. left := caddnode.create(addn,left,
  404. caddnode.create(andn,
  405. cshlshrnode.create(sarn,left.getcopy,
  406. cordconstnode.create(shiftval,sinttype,false)),
  407. cordconstnode.create(tordconstnode(right).value-1,
  408. right.resultdef,false)));
  409. newtype := sarn;
  410. end
  411. else
  412. *)
  413. newtype := shrn;
  414. tordconstnode(right).value := power;
  415. result := cshlshrnode.create(newtype,left,right)
  416. end
  417. else
  418. begin
  419. dec(tordconstnode(right).value.uvalue);
  420. result := caddnode.create(andn,left,right);
  421. end;
  422. { left and right are reused }
  423. left := nil;
  424. right := nil;
  425. firstpass(result);
  426. exit;
  427. end;
  428. end;
  429. function tmoddivnode.pass_1 : tnode;
  430. begin
  431. result:=nil;
  432. firstpass(left);
  433. firstpass(right);
  434. if codegenerror then
  435. exit;
  436. { Try to optimize mod/div }
  437. result := firstoptimize;
  438. if assigned(result) then
  439. exit;
  440. {$ifndef cpu64bitalu}
  441. { 64bit }
  442. if (left.resultdef.typ=orddef) and
  443. (right.resultdef.typ=orddef) and
  444. (is_64bitint(left.resultdef) or is_64bitint(right.resultdef)) then
  445. begin
  446. result := first_moddiv64bitint;
  447. if assigned(result) then
  448. exit;
  449. expectloc:=LOC_REGISTER;
  450. end
  451. else
  452. {$endif not cpu64bitalu}
  453. begin
  454. result := first_moddivint;
  455. if assigned(result) then
  456. exit;
  457. end;
  458. expectloc:=LOC_REGISTER;
  459. end;
  460. {****************************************************************************
  461. TSHLSHRNODE
  462. ****************************************************************************}
  463. function tshlshrnode.simplify(forinline : boolean):tnode;
  464. begin
  465. result:=nil;
  466. { constant folding }
  467. if is_constintnode(left) and is_constintnode(right) then
  468. begin
  469. case nodetype of
  470. shrn:
  471. result:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline);
  472. shln:
  473. result:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline);
  474. end;
  475. end;
  476. end;
  477. function tshlshrnode.pass_typecheck:tnode;
  478. var
  479. t : tnode;
  480. {$ifdef cpunodefaultint}
  481. nd : tdef;
  482. {$endif cpunodefaultint}
  483. begin
  484. result:=nil;
  485. typecheckpass(left);
  486. typecheckpass(right);
  487. set_varstate(right,vs_read,[vsf_must_be_valid]);
  488. set_varstate(left,vs_read,[vsf_must_be_valid]);
  489. if codegenerror then
  490. exit;
  491. { tp procvar support }
  492. maybe_call_procvar(left,true);
  493. maybe_call_procvar(right,true);
  494. result:=simplify(false);
  495. if assigned(result) then
  496. exit;
  497. { allow operator overloading }
  498. t:=self;
  499. if isbinaryoverloaded(t) then
  500. begin
  501. result:=t;
  502. exit;
  503. end;
  504. {$ifdef cpunodefaultint}
  505. { for small cpus we use the smallest common type }
  506. if (left.resultdef.typ=orddef) and (right.resultdef.typ=orddef) then
  507. nd:=get_common_intdef(torddef(left.resultdef),torddef(right.resultdef),false)
  508. else
  509. nd:=s32inttype;
  510. {$endif cpunodefaultint}
  511. { calculations for ordinals < 32 bit have to be done in
  512. 32 bit for backwards compatibility. That way 'shl 33' is
  513. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  514. if (not is_64bit(left.resultdef)) and
  515. (torddef(left.resultdef).ordtype<>u32bit) then
  516. begin
  517. { keep singness of orignal type }
  518. if is_signed(left.resultdef) then
  519. {$ifdef cpunodefaultint}
  520. inserttypeconv(left,nd)
  521. {$else cpunodefaultint}
  522. inserttypeconv(left,s32inttype)
  523. {$endif cpunodefaultint}
  524. else
  525. begin
  526. {$ifdef cpunodefaultint}
  527. inserttypeconv(left,nd)
  528. {$else cpunodefaultint}
  529. inserttypeconv(left,u32inttype);
  530. {$endif cpunodefaultint}
  531. end
  532. end;
  533. {$ifdef cpunodefaultint}
  534. inserttypeconv(right,nd);
  535. {$else cpunodefaultint}
  536. inserttypeconv(right,sinttype);
  537. {$endif cpunodefaultint}
  538. resultdef:=left.resultdef;
  539. end;
  540. {$ifndef cpu64bitalu}
  541. function tshlshrnode.first_shlshr64bitint: tnode;
  542. var
  543. procname: string[31];
  544. begin
  545. result := nil;
  546. { Normally already done below, but called again,
  547. just in case it is called directly }
  548. firstpass(left);
  549. { otherwise create a call to a helper }
  550. if is_signed(left.resultdef) then
  551. procname:='int64'
  552. else
  553. procname:='qword';
  554. if nodetype = shln then
  555. procname := 'fpc_shl_'+procname
  556. else
  557. procname := 'fpc_shr_'+procname;
  558. { this order of parameters works at least for the arm,
  559. however it should work for any calling conventions (FK) }
  560. result := ccallnode.createintern(procname,ccallparanode.create(right,
  561. ccallparanode.create(left,nil)));
  562. left := nil;
  563. right := nil;
  564. firstpass(result);
  565. end;
  566. {$endif not cpu64bitalu}
  567. function tshlshrnode.pass_1 : tnode;
  568. var
  569. regs : longint;
  570. begin
  571. result:=nil;
  572. firstpass(left);
  573. firstpass(right);
  574. if codegenerror then
  575. exit;
  576. {$ifndef cpu64bitalu}
  577. { 64 bit ints have their own shift handling }
  578. if is_64bit(left.resultdef) then
  579. begin
  580. result := first_shlshr64bitint;
  581. if assigned(result) then
  582. exit;
  583. regs:=2;
  584. end
  585. else
  586. {$endif not cpu64bitalu}
  587. begin
  588. regs:=1
  589. end;
  590. if (right.nodetype<>ordconstn) then
  591. inc(regs);
  592. expectloc:=LOC_REGISTER;
  593. end;
  594. {****************************************************************************
  595. TUNARYMINUSNODE
  596. ****************************************************************************}
  597. constructor tunaryminusnode.create(expr : tnode);
  598. begin
  599. inherited create(unaryminusn,expr);
  600. end;
  601. function tunaryminusnode.simplify(forinline : boolean):tnode;
  602. begin
  603. result:=nil;
  604. { constant folding }
  605. if is_constintnode(left) then
  606. begin
  607. result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
  608. exit;
  609. end;
  610. if is_constrealnode(left) then
  611. begin
  612. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  613. trealconstnode(left).value_currency:=-trealconstnode(left).value_currency;
  614. result:=left;
  615. left:=nil;
  616. exit;
  617. end;
  618. end;
  619. function tunaryminusnode.pass_typecheck : tnode;
  620. var
  621. t : tnode;
  622. begin
  623. result:=nil;
  624. typecheckpass(left);
  625. set_varstate(left,vs_read,[vsf_must_be_valid]);
  626. if codegenerror then
  627. exit;
  628. result:=simplify(false);
  629. if assigned(result) then
  630. exit;
  631. resultdef:=left.resultdef;
  632. if (left.resultdef.typ=floatdef) or
  633. is_currency(left.resultdef) then
  634. begin
  635. end
  636. {$ifdef SUPPORT_MMX}
  637. else if (cs_mmx in current_settings.localswitches) and
  638. is_mmx_able_array(left.resultdef) then
  639. begin
  640. { if saturation is on, left.resultdef isn't
  641. "mmx able" (FK)
  642. if (cs_mmx_saturation in current_settings.localswitches^) and
  643. (torddef(tarraydef(resultdef).definition).typ in
  644. [s32bit,u32bit]) then
  645. CGMessage(type_e_mismatch);
  646. }
  647. end
  648. {$endif SUPPORT_MMX}
  649. {$ifndef cpu64bitaddr}
  650. else if is_64bit(left.resultdef) then
  651. begin
  652. inserttypeconv(left,s64inttype);
  653. resultdef:=left.resultdef
  654. end
  655. {$endif not cpu64bitaddr}
  656. else if (left.resultdef.typ=orddef) then
  657. begin
  658. inserttypeconv(left,sinttype);
  659. resultdef:=left.resultdef
  660. end
  661. else
  662. begin
  663. { allow operator overloading }
  664. t:=self;
  665. if isunaryoverloaded(t) then
  666. begin
  667. result:=t;
  668. exit;
  669. end;
  670. CGMessage(type_e_mismatch);
  671. end;
  672. end;
  673. { generic code }
  674. { overridden by: }
  675. { i386 }
  676. function tunaryminusnode.pass_1 : tnode;
  677. var
  678. procname: string[31];
  679. fdef : tdef;
  680. begin
  681. result:=nil;
  682. firstpass(left);
  683. if codegenerror then
  684. exit;
  685. if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then
  686. begin
  687. if not(target_info.system in systems_wince) then
  688. begin
  689. case tfloatdef(resultdef).floattype of
  690. s32real:
  691. begin
  692. procname:='float32_sub';
  693. fdef:=search_system_type('FLOAT32REC').typedef;
  694. end;
  695. s64real:
  696. begin
  697. procname:='float64_sub';
  698. fdef:=search_system_type('FLOAT64').typedef;
  699. end;
  700. {!!! not yet implemented
  701. s128real:
  702. }
  703. else
  704. internalerror(2005082801);
  705. end;
  706. result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
  707. ctypeconvnode.create_internal(left,fDef),
  708. ccallparanode.create(ctypeconvnode.create_internal(crealconstnode.create(0,resultdef),fdef),nil))),resultdef);
  709. end
  710. else
  711. begin
  712. case tfloatdef(resultdef).floattype of
  713. s32real:
  714. procname:='NEGS';
  715. s64real:
  716. procname:='NEGD';
  717. {!!! not yet implemented
  718. s128real:
  719. }
  720. else
  721. internalerror(2005082802);
  722. end;
  723. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  724. end;
  725. left:=nil;
  726. end
  727. else
  728. begin
  729. if (left.resultdef.typ=floatdef) then
  730. expectloc:=LOC_FPUREGISTER
  731. {$ifdef SUPPORT_MMX}
  732. else if (cs_mmx in current_settings.localswitches) and
  733. is_mmx_able_array(left.resultdef) then
  734. expectloc:=LOC_MMXREGISTER
  735. {$endif SUPPORT_MMX}
  736. else if (left.resultdef.typ=orddef) then
  737. expectloc:=LOC_REGISTER;
  738. end;
  739. end;
  740. {****************************************************************************
  741. TUNARYPLUSNODE
  742. ****************************************************************************}
  743. constructor tunaryplusnode.create(expr: tnode);
  744. begin
  745. inherited create(unaryplusn,expr);
  746. end;
  747. function tunaryplusnode.pass_1: tnode;
  748. begin
  749. result:=nil;
  750. { can never happen because all the conversions happen
  751. in pass_typecheck }
  752. internalerror(201012250);
  753. end;
  754. function tunaryplusnode.pass_typecheck: tnode;
  755. var
  756. t:tnode;
  757. begin
  758. result:=nil;
  759. typecheckpass(left);
  760. set_varstate(left,vs_read,[vsf_must_be_valid]);
  761. if codegenerror then
  762. exit;
  763. if is_constintnode(left) or
  764. is_constrealnode(left) or
  765. (left.resultdef.typ=floatdef) or
  766. is_currency(left.resultdef)
  767. {$ifdef SUPPORT_MMX}
  768. or ((cs_mmx in current_settings.localswitches) and
  769. is_mmx_able_array(left.resultdef))
  770. {$endif SUPPORT_MMX}
  771. then
  772. begin
  773. result:=left;
  774. left:=nil;
  775. end
  776. {$ifndef cpu64bitaddr}
  777. else if is_64bit(left.resultdef) then
  778. begin
  779. inserttypeconv(left,s64inttype);
  780. result:=left;
  781. left:=nil;
  782. end
  783. {$endif not cpu64bitaddr}
  784. else if (left.resultdef.typ=orddef) then
  785. begin
  786. inserttypeconv(left,sinttype);
  787. result:=left;
  788. left:=nil;
  789. end
  790. else
  791. begin
  792. { allow operator overloading }
  793. t:=self;
  794. if isunaryoverloaded(t) then
  795. begin
  796. result:=t;
  797. exit;
  798. end;
  799. CGMessage(type_e_mismatch);
  800. end;
  801. end;
  802. {****************************************************************************
  803. TNOTNODE
  804. ****************************************************************************}
  805. const
  806. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  807. gten,gtn,lten,ltn,unequaln,equaln
  808. );
  809. constructor tnotnode.create(expr : tnode);
  810. begin
  811. inherited create(notn,expr);
  812. end;
  813. function tnotnode.simplify(forinline : boolean):tnode;
  814. var
  815. v : tconstexprint;
  816. t : tnode;
  817. def : tdef;
  818. begin
  819. result:=nil;
  820. { Try optmimizing ourself away }
  821. if left.nodetype=notn then
  822. begin
  823. { Double not. Remove both }
  824. result:=Tnotnode(left).left;
  825. tnotnode(left).left:=nil;
  826. exit;
  827. end;
  828. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  829. begin
  830. { Not of boolean expression. Turn around the operator and remove
  831. the not. This is not allowed for sets with the gten/lten,
  832. because there is no ltn/gtn support }
  833. if (taddnode(left).left.resultdef.typ<>setdef) or
  834. (left.nodetype in [equaln,unequaln]) then
  835. begin
  836. result:=left;
  837. left.nodetype:=boolean_reverse[left.nodetype];
  838. left:=nil;
  839. exit;
  840. end;
  841. end;
  842. { constant folding }
  843. if (left.nodetype=ordconstn) then
  844. begin
  845. v:=tordconstnode(left).value;
  846. def:=left.resultdef;
  847. case torddef(left.resultdef).ordtype of
  848. pasbool8,
  849. pasbool16,
  850. pasbool32,
  851. pasbool64,
  852. bool8bit,
  853. bool16bit,
  854. bool32bit,
  855. bool64bit:
  856. begin
  857. v:=byte(not(boolean(int64(v))));
  858. if is_cbool(left.resultdef) then
  859. v:=-v;
  860. end;
  861. uchar,
  862. uwidechar,
  863. u8bit,
  864. s8bit,
  865. u16bit,
  866. s16bit,
  867. s32bit,
  868. {$ifdef cpu64bitaddr}
  869. u32bit,
  870. {$endif cpu64bitaddr}
  871. s64bit:
  872. begin
  873. v:=int64(not int64(v));
  874. if (torddef(left.resultdef).ordtype<>s64bit) then
  875. def:=sinttype
  876. else
  877. def:=s64inttype;
  878. end;
  879. {$ifndef cpu64bitaddr}
  880. u32bit,
  881. {$endif not cpu64bitaddr}
  882. u64bit :
  883. begin
  884. { Delphi-compatible: not dword = dword (not word = longint) }
  885. { Extension: not qword = qword }
  886. v:=qword(not qword(v));
  887. { will be truncated by the ordconstnode for u32bit }
  888. end;
  889. else
  890. CGMessage(type_e_mismatch);
  891. end;
  892. if not forinline then
  893. t:=cordconstnode.create(v,def,false)
  894. else
  895. t:=create_simplified_ord_const(v,resultdef,true);
  896. result:=t;
  897. exit;
  898. end;
  899. end;
  900. function tnotnode.pass_typecheck : tnode;
  901. var
  902. t : tnode;
  903. begin
  904. result:=nil;
  905. typecheckpass(left);
  906. set_varstate(left,vs_read,[vsf_must_be_valid]);
  907. if codegenerror then
  908. exit;
  909. { tp procvar support }
  910. maybe_call_procvar(left,true);
  911. resultdef:=left.resultdef;
  912. result:=simplify(false);
  913. if assigned(result) then
  914. exit;
  915. if is_boolean(resultdef) then
  916. begin
  917. end
  918. else
  919. {$ifdef SUPPORT_MMX}
  920. if (cs_mmx in current_settings.localswitches) and
  921. is_mmx_able_array(left.resultdef) then
  922. begin
  923. end
  924. else
  925. {$endif SUPPORT_MMX}
  926. {$ifndef cpu64bitaddr}
  927. if is_64bitint(left.resultdef) then
  928. begin
  929. end
  930. else
  931. {$endif not cpu64bitaddr}
  932. if is_integer(left.resultdef) then
  933. begin
  934. end
  935. else
  936. begin
  937. { allow operator overloading }
  938. t:=self;
  939. if isunaryoverloaded(t) then
  940. begin
  941. result:=t;
  942. exit;
  943. end;
  944. CGMessage(type_e_mismatch);
  945. end;
  946. end;
  947. function tnotnode.pass_1 : tnode;
  948. begin
  949. result:=nil;
  950. firstpass(left);
  951. if codegenerror then
  952. exit;
  953. expectloc:=left.expectloc;
  954. if is_boolean(resultdef) then
  955. begin
  956. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  957. expectloc:=LOC_REGISTER;
  958. { before loading it into flags we need to load it into
  959. a register thus 1 register is need PM }
  960. {$ifdef cpuflags}
  961. if left.expectloc<>LOC_JUMP then
  962. expectloc:=LOC_FLAGS;
  963. {$endif def cpuflags}
  964. end
  965. else
  966. {$ifdef SUPPORT_MMX}
  967. if (cs_mmx in current_settings.localswitches) and
  968. is_mmx_able_array(left.resultdef) then
  969. expectloc:=LOC_MMXREGISTER
  970. else
  971. {$endif SUPPORT_MMX}
  972. {$ifndef cpu64bitalu}
  973. if is_64bit(left.resultdef) then
  974. begin
  975. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  976. expectloc:=LOC_REGISTER;
  977. end
  978. else
  979. {$endif not cpu64bitalu}
  980. if is_integer(left.resultdef) then
  981. expectloc:=LOC_REGISTER;
  982. end;
  983. {$ifdef state_tracking}
  984. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  985. begin
  986. track_state_pass:=true;
  987. if left.track_state_pass(exec_known) then
  988. begin
  989. left.resultdef:=nil;
  990. do_typecheckpass(left);
  991. end;
  992. end;
  993. {$endif}
  994. end.