nmat.pas 33 KB

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