nmat.pas 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049
  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,
  90. nutils;
  91. {****************************************************************************
  92. TMODDIVNODE
  93. ****************************************************************************}
  94. function tmoddivnode.simplify(forinline : boolean):tnode;
  95. var
  96. t : tnode;
  97. rv,lv : tconstexprint;
  98. begin
  99. result:=nil;
  100. if is_constintnode(right) then
  101. begin
  102. if tordconstnode(right).value = 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 tordconstnode(right).value = 0 then
  113. begin
  114. Message(parser_e_division_by_zero);
  115. { recover }
  116. tordconstnode(right).value := 1;
  117. end;
  118. end;
  119. if is_constintnode(right) and is_constintnode(left) then
  120. begin
  121. rv:=tordconstnode(right).value;
  122. lv:=tordconstnode(left).value;
  123. case nodetype of
  124. modn:
  125. t:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
  126. divn:
  127. t:=create_simplified_ord_const(lv div rv,resultdef,forinline);
  128. end;
  129. result:=t;
  130. exit;
  131. end;
  132. end;
  133. function tmoddivnode.pass_typecheck:tnode;
  134. var
  135. hp,t : tnode;
  136. rd,ld : torddef;
  137. begin
  138. result:=nil;
  139. typecheckpass(left);
  140. typecheckpass(right);
  141. set_varstate(left,vs_read,[vsf_must_be_valid]);
  142. set_varstate(right,vs_read,[vsf_must_be_valid]);
  143. if codegenerror then
  144. exit;
  145. { tp procvar support }
  146. maybe_call_procvar(left,true);
  147. maybe_call_procvar(right,true);
  148. result:=simplify(false);
  149. if assigned(result) then
  150. exit;
  151. { allow operator overloading }
  152. t:=self;
  153. if isbinaryoverloaded(t) then
  154. begin
  155. result:=t;
  156. exit;
  157. end;
  158. { we need 2 orddefs always }
  159. if (left.resultdef.typ<>orddef) then
  160. inserttypeconv(right,sinttype);
  161. if (right.resultdef.typ<>orddef) then
  162. inserttypeconv(right,sinttype);
  163. if codegenerror then
  164. exit;
  165. rd:=torddef(right.resultdef);
  166. ld:=torddef(left.resultdef);
  167. { if one operand is a cardinal and the other is a positive constant, convert the }
  168. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  169. { Do the same for qwords and positive constants as well, otherwise things like }
  170. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  171. { "qword" was > high(int64) (JM) }
  172. { Additionally, do the same for cardinal/qwords and other positive types, but }
  173. { always in a way that a smaller type is converted to a bigger type }
  174. { (webtbs/tw8870) }
  175. if (rd.ordtype in [u32bit,u64bit]) and
  176. ((is_constintnode(left) and
  177. (tordconstnode(left).value >= 0)) or
  178. (not is_signed(ld) and
  179. (rd.size >= ld.size))) then
  180. begin
  181. inserttypeconv(left,right.resultdef);
  182. ld:=torddef(left.resultdef);
  183. end;
  184. if (ld.ordtype in [u32bit,u64bit]) and
  185. ((is_constintnode(right) and
  186. (tordconstnode(right).value >= 0)) or
  187. (not is_signed(rd) and
  188. (ld.size >= rd.size))) then
  189. begin
  190. inserttypeconv(right,left.resultdef);
  191. rd:=torddef(right.resultdef);
  192. end;
  193. { when there is one currency value, everything is done
  194. using currency }
  195. if (ld.ordtype=scurrency) or
  196. (rd.ordtype=scurrency) then
  197. begin
  198. if (ld.ordtype<>scurrency) then
  199. inserttypeconv(left,s64currencytype);
  200. if (rd.ordtype<>scurrency) then
  201. inserttypeconv(right,s64currencytype);
  202. resultdef:=left.resultdef;
  203. end
  204. else
  205. {$ifndef cpu64bitaddr}
  206. { when there is one 64bit value, everything is done
  207. in 64bit }
  208. if (is_64bitint(left.resultdef) or
  209. is_64bitint(right.resultdef)) then
  210. begin
  211. if is_signed(rd) or is_signed(ld) then
  212. begin
  213. if (ld.ordtype<>s64bit) then
  214. inserttypeconv(left,s64inttype);
  215. if (rd.ordtype<>s64bit) then
  216. inserttypeconv(right,s64inttype);
  217. end
  218. else
  219. begin
  220. if (ld.ordtype<>u64bit) then
  221. inserttypeconv(left,u64inttype);
  222. if (rd.ordtype<>u64bit) then
  223. inserttypeconv(right,u64inttype);
  224. end;
  225. resultdef:=left.resultdef;
  226. end
  227. else
  228. { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
  229. if ((rd.ordtype = u32bit) and
  230. is_signed(ld)) or
  231. ((ld.ordtype = u32bit) and
  232. is_signed(rd)) then
  233. begin
  234. CGMessage(type_h_mixed_signed_unsigned);
  235. if (ld.ordtype<>s64bit) then
  236. inserttypeconv(left,s64inttype);
  237. if (rd.ordtype<>s64bit) then
  238. inserttypeconv(right,s64inttype);
  239. resultdef:=left.resultdef;
  240. end
  241. else
  242. {$endif not cpu64bitaddr}
  243. begin
  244. { Make everything always default singed int }
  245. if not(rd.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  246. inserttypeconv(right,sinttype);
  247. if not(ld.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  248. inserttypeconv(left,sinttype);
  249. resultdef:=right.resultdef;
  250. end;
  251. { when the result is currency we need some extra code for
  252. division. this should not be done when the divn node is
  253. created internally }
  254. if (nodetype=divn) and
  255. not(nf_is_currency in flags) and
  256. is_currency(resultdef) then
  257. begin
  258. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  259. include(hp.flags,nf_is_currency);
  260. result:=hp;
  261. end;
  262. end;
  263. function tmoddivnode.first_moddivint: tnode;
  264. {$ifdef cpuneedsdiv32helper}
  265. var
  266. procname: string[31];
  267. begin
  268. result := nil;
  269. { otherwise create a call to a helper }
  270. if nodetype = divn then
  271. procname := 'fpc_div_'
  272. else
  273. procname := 'fpc_mod_';
  274. { only qword needs the unsigned code, the
  275. signed code is also used for currency }
  276. if is_signed(resultdef) then
  277. procname := procname + 'longint'
  278. else
  279. procname := procname + 'dword';
  280. result := ccallnode.createintern(procname,ccallparanode.create(left,
  281. ccallparanode.create(right,nil)));
  282. left := nil;
  283. right := nil;
  284. firstpass(result);
  285. end;
  286. {$else cpuneedsdiv32helper}
  287. begin
  288. result:=nil;
  289. end;
  290. {$endif cpuneedsdiv32helper}
  291. {$ifndef cpu64bitalu}
  292. function tmoddivnode.first_moddiv64bitint: tnode;
  293. var
  294. procname: string[31];
  295. begin
  296. result := nil;
  297. { when currency is used set the result of the
  298. parameters to s64bit, so they are not converted }
  299. if is_currency(resultdef) then
  300. begin
  301. left.resultdef:=s64inttype;
  302. right.resultdef:=s64inttype;
  303. end;
  304. { otherwise create a call to a helper }
  305. if nodetype = divn then
  306. procname := 'fpc_div_'
  307. else
  308. procname := 'fpc_mod_';
  309. { only qword needs the unsigned code, the
  310. signed code is also used for currency }
  311. if is_signed(resultdef) then
  312. procname := procname + 'int64'
  313. else
  314. procname := procname + 'qword';
  315. result := ccallnode.createintern(procname,ccallparanode.create(left,
  316. ccallparanode.create(right,nil)));
  317. left := nil;
  318. right := nil;
  319. firstpass(result);
  320. end;
  321. {$endif not cpu64bitalu}
  322. function tmoddivnode.firstoptimize: tnode;
  323. var
  324. power{,shiftval} : longint;
  325. newtype: tnodetype;
  326. begin
  327. result := nil;
  328. { divide/mod a number by a constant which is a power of 2? }
  329. if (cs_opt_peephole in current_settings.optimizerswitches) and
  330. (right.nodetype = ordconstn) and
  331. { ((nodetype = divn) or
  332. not is_signed(resultdef)) and}
  333. (not is_signed(resultdef)) and
  334. ispowerof2(tordconstnode(right).value,power) then
  335. begin
  336. if nodetype = divn then
  337. begin
  338. (*
  339. if is_signed(resultdef) then
  340. begin
  341. if is_64bitint(left.resultdef) then
  342. if not (cs_opt_size in current_settings.optimizerswitches) then
  343. shiftval := 63
  344. else
  345. { the shift code is a lot bigger than the call to }
  346. { the divide helper }
  347. exit
  348. else
  349. shiftval := 31;
  350. { we reuse left twice, so create once a copy of it }
  351. { !!! if left is a call is -> call gets executed twice }
  352. left := caddnode.create(addn,left,
  353. caddnode.create(andn,
  354. cshlshrnode.create(sarn,left.getcopy,
  355. cordconstnode.create(shiftval,sinttype,false)),
  356. cordconstnode.create(tordconstnode(right).value-1,
  357. right.resultdef,false)));
  358. newtype := sarn;
  359. end
  360. else
  361. *)
  362. newtype := shrn;
  363. tordconstnode(right).value := power;
  364. result := cshlshrnode.create(newtype,left,right)
  365. end
  366. else
  367. begin
  368. dec(tordconstnode(right).value.uvalue);
  369. result := caddnode.create(andn,left,right);
  370. end;
  371. { left and right are reused }
  372. left := nil;
  373. right := nil;
  374. firstpass(result);
  375. exit;
  376. end;
  377. end;
  378. function tmoddivnode.pass_1 : tnode;
  379. begin
  380. result:=nil;
  381. firstpass(left);
  382. firstpass(right);
  383. if codegenerror then
  384. exit;
  385. { Try to optimize mod/div }
  386. result := firstoptimize;
  387. if assigned(result) then
  388. exit;
  389. {$ifndef cpu64bitalu}
  390. { 64bit }
  391. if (left.resultdef.typ=orddef) and
  392. (right.resultdef.typ=orddef) and
  393. (is_64bitint(left.resultdef) or is_64bitint(right.resultdef)) then
  394. begin
  395. result := first_moddiv64bitint;
  396. if assigned(result) then
  397. exit;
  398. expectloc:=LOC_REGISTER;
  399. end
  400. else
  401. {$endif not cpu64bitalu}
  402. begin
  403. result := first_moddivint;
  404. if assigned(result) then
  405. exit;
  406. end;
  407. expectloc:=LOC_REGISTER;
  408. end;
  409. {****************************************************************************
  410. TSHLSHRNODE
  411. ****************************************************************************}
  412. function tshlshrnode.simplify(forinline : boolean):tnode;
  413. var
  414. t : tnode;
  415. begin
  416. result:=nil;
  417. { constant folding }
  418. if is_constintnode(left) and is_constintnode(right) then
  419. begin
  420. case nodetype of
  421. shrn:
  422. t:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline);
  423. shln:
  424. t:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline);
  425. end;
  426. result:=t;
  427. exit;
  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. pasbool,
  802. bool8bit,
  803. bool16bit,
  804. bool32bit,
  805. bool64bit:
  806. begin
  807. v:=byte(not(boolean(int64(v))));
  808. if (torddef(left.resultdef).ordtype<>pasbool) then
  809. v:=-v;
  810. end;
  811. uchar,
  812. uwidechar,
  813. u8bit,
  814. s8bit,
  815. u16bit,
  816. s16bit,
  817. s32bit,
  818. {$ifdef cpu64bitaddr}
  819. u32bit,
  820. {$endif cpu64bitaddr}
  821. s64bit:
  822. begin
  823. v:=int64(not int64(v));
  824. if (torddef(left.resultdef).ordtype<>s64bit) then
  825. def:=sinttype
  826. else
  827. def:=s64inttype;
  828. end;
  829. {$ifndef cpu64bitaddr}
  830. u32bit,
  831. {$endif not cpu64bitaddr}
  832. u64bit :
  833. begin
  834. { Delphi-compatible: not dword = dword (not word = longint) }
  835. { Extension: not qword = qword }
  836. v:=qword(not qword(v));
  837. { will be truncated by the ordconstnode for u32bit }
  838. end;
  839. else
  840. CGMessage(type_e_mismatch);
  841. end;
  842. if not forinline then
  843. t:=cordconstnode.create(v,def,false)
  844. else
  845. t:=create_simplified_ord_const(v,resultdef,true);
  846. result:=t;
  847. exit;
  848. end;
  849. end;
  850. function tnotnode.pass_typecheck : tnode;
  851. var
  852. t : tnode;
  853. begin
  854. result:=nil;
  855. typecheckpass(left);
  856. set_varstate(left,vs_read,[vsf_must_be_valid]);
  857. if codegenerror then
  858. exit;
  859. { tp procvar support }
  860. maybe_call_procvar(left,true);
  861. resultdef:=left.resultdef;
  862. result:=simplify(false);
  863. if assigned(result) then
  864. exit;
  865. if is_boolean(resultdef) then
  866. begin
  867. end
  868. else
  869. {$ifdef SUPPORT_MMX}
  870. if (cs_mmx in current_settings.localswitches) and
  871. is_mmx_able_array(left.resultdef) then
  872. begin
  873. end
  874. else
  875. {$endif SUPPORT_MMX}
  876. {$ifndef cpu64bitaddr}
  877. if is_64bitint(left.resultdef) then
  878. begin
  879. end
  880. else
  881. {$endif not cpu64bitaddr}
  882. if is_integer(left.resultdef) then
  883. begin
  884. end
  885. else
  886. begin
  887. { allow operator overloading }
  888. t:=self;
  889. if isunaryoverloaded(t) then
  890. begin
  891. result:=t;
  892. exit;
  893. end;
  894. CGMessage(type_e_mismatch);
  895. end;
  896. end;
  897. function tnotnode.pass_1 : tnode;
  898. begin
  899. result:=nil;
  900. firstpass(left);
  901. if codegenerror then
  902. exit;
  903. expectloc:=left.expectloc;
  904. if is_boolean(resultdef) then
  905. begin
  906. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  907. expectloc:=LOC_REGISTER;
  908. { before loading it into flags we need to load it into
  909. a register thus 1 register is need PM }
  910. {$ifdef cpuflags}
  911. if left.expectloc<>LOC_JUMP then
  912. expectloc:=LOC_FLAGS;
  913. {$endif def cpuflags}
  914. end
  915. else
  916. {$ifdef SUPPORT_MMX}
  917. if (cs_mmx in current_settings.localswitches) and
  918. is_mmx_able_array(left.resultdef) then
  919. expectloc:=LOC_MMXREGISTER
  920. else
  921. {$endif SUPPORT_MMX}
  922. {$ifndef cpu64bitalu}
  923. if is_64bit(left.resultdef) then
  924. begin
  925. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  926. expectloc:=LOC_REGISTER;
  927. end
  928. else
  929. {$endif not cpu64bitalu}
  930. if is_integer(left.resultdef) then
  931. expectloc:=LOC_REGISTER;
  932. end;
  933. {$ifdef state_tracking}
  934. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  935. begin
  936. track_state_pass:=true;
  937. if left.track_state_pass(exec_known) then
  938. begin
  939. left.resultdef:=nil;
  940. do_typecheckpass(left);
  941. end;
  942. end;
  943. {$endif}
  944. end.