nmat.pas 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360
  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,compinnr,
  83. globtype,constexp,
  84. symconst,symtype,symdef,
  85. defutil,
  86. htypechk,pass_1,
  87. cgbase,
  88. ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl,
  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. rv:=tordconstnode(right).value;
  101. if rv = 1 then
  102. begin
  103. case nodetype of
  104. modn:
  105. result := cordconstnode.create(0,left.resultdef,true);
  106. divn:
  107. result := left.getcopy;
  108. end;
  109. exit;
  110. end;
  111. if rv = 0 then
  112. begin
  113. Message(parser_e_division_by_zero);
  114. { recover }
  115. tordconstnode(right).value := 1;
  116. end;
  117. { the following simplification is also required for correctness
  118. on x86, as its transformation of divisions by constants to
  119. multiplications and shifts does not handle -1 correctly }
  120. if (rv=-1) and
  121. (nodetype=divn) then
  122. begin
  123. result:=cunaryminusnode.create(left);
  124. left:=nil;
  125. exit;
  126. end;
  127. if (nf_isomod in flags) and
  128. (rv<=0) then
  129. begin
  130. Message(cg_e_mod_only_defined_for_pos_quotient);
  131. { recover }
  132. tordconstnode(right).value := 1;
  133. end;
  134. end;
  135. if is_constintnode(right) and is_constintnode(left) then
  136. begin
  137. rv:=tordconstnode(right).value;
  138. lv:=tordconstnode(left).value;
  139. case nodetype of
  140. modn:
  141. if nf_isomod in flags then
  142. begin
  143. if lv>=0 then
  144. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline)
  145. else
  146. if ((-lv) mod rv)=0 then
  147. result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline)
  148. else
  149. result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline);
  150. end
  151. else
  152. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
  153. divn:
  154. result:=create_simplified_ord_const(lv div rv,resultdef,forinline);
  155. end;
  156. end;
  157. end;
  158. function tmoddivnode.use_moddiv64bitint_helper: boolean;
  159. begin
  160. { not with an ifdef around the call to this routine, because e.g. the
  161. Java VM has a signed 64 bit division opcode, but not an unsigned
  162. one }
  163. {$ifdef cpu64bitalu}
  164. result:=false;
  165. {$else cpu64bitalu}
  166. result:=
  167. (left.resultdef.typ=orddef) and
  168. (right.resultdef.typ=orddef) and
  169. (is_64bitint(left.resultdef) or is_64bitint(right.resultdef));
  170. {$endif cpu64bitaly}
  171. end;
  172. function tmoddivnode.pass_typecheck:tnode;
  173. var
  174. else_block,
  175. hp,t : tnode;
  176. rd,ld : torddef;
  177. else_statements,
  178. statements : tstatementnode;
  179. result_data : ttempcreatenode;
  180. nd : torddef;
  181. begin
  182. result:=nil;
  183. typecheckpass(left);
  184. typecheckpass(right);
  185. { avoid any problems with type parameters later on }
  186. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  187. begin
  188. resultdef:=cundefinedtype;
  189. exit;
  190. end;
  191. set_varstate(left,vs_read,[vsf_must_be_valid]);
  192. set_varstate(right,vs_read,[vsf_must_be_valid]);
  193. if codegenerror then
  194. exit;
  195. { tp procvar support }
  196. maybe_call_procvar(left,true);
  197. maybe_call_procvar(right,true);
  198. { allow operator overloading }
  199. t:=self;
  200. if isbinaryoverloaded(t) then
  201. begin
  202. result:=t;
  203. exit;
  204. end;
  205. { we need 2 orddefs always }
  206. if (left.resultdef.typ<>orddef) then
  207. inserttypeconv(left,sinttype);
  208. if (right.resultdef.typ<>orddef) then
  209. inserttypeconv(right,sinttype);
  210. if codegenerror then
  211. exit;
  212. { Try only now to simply constant
  213. as otherwise you might create
  214. tconstnode with return type that are
  215. not compatible with tconst node
  216. as in bug report 21566 PM }
  217. result:=simplify(false);
  218. if assigned(result) then
  219. exit;
  220. rd:=torddef(right.resultdef);
  221. ld:=torddef(left.resultdef);
  222. { if one operand is a cardinal and the other is a positive constant, convert the }
  223. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  224. { Do the same for qwords and positive constants as well, otherwise things like }
  225. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  226. { "qword" was > high(int64) (JM) }
  227. { Additionally, do the same for cardinal/qwords and other positive types, but }
  228. { always in a way that a smaller type is converted to a bigger type }
  229. { (webtbs/tw8870) }
  230. if (rd.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
  231. ((is_constintnode(left) and
  232. (tordconstnode(left).value >= 0) and
  233. (tordconstnode(left).value <= get_max_value(rd))) or
  234. (not is_signed(ld) and
  235. (rd.size >= ld.size))) then
  236. begin
  237. inserttypeconv(left,right.resultdef);
  238. ld:=torddef(left.resultdef);
  239. end;
  240. if (ld.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
  241. ((is_constintnode(right) and
  242. (tordconstnode(right).value >= 0) and
  243. (tordconstnode(right).value <= get_max_value(ld))) or
  244. (not is_signed(rd) and
  245. (ld.size >= rd.size))) then
  246. begin
  247. inserttypeconv(right,left.resultdef);
  248. rd:=torddef(right.resultdef);
  249. end;
  250. { when there is one currency value, everything is done
  251. using currency }
  252. if (ld.ordtype=scurrency) or
  253. (rd.ordtype=scurrency) then
  254. begin
  255. if (ld.ordtype<>scurrency) then
  256. inserttypeconv(left,s64currencytype);
  257. if (rd.ordtype<>scurrency) then
  258. inserttypeconv(right,s64currencytype);
  259. resultdef:=left.resultdef;
  260. end
  261. else
  262. { when there is one 64bit value, everything is done
  263. in 64bit }
  264. if (is_64bitint(left.resultdef) or
  265. is_64bitint(right.resultdef)) then
  266. begin
  267. if is_signed(rd) or is_signed(ld) then
  268. begin
  269. if (ld.ordtype<>s64bit) then
  270. inserttypeconv(left,s64inttype);
  271. if (rd.ordtype<>s64bit) then
  272. inserttypeconv(right,s64inttype);
  273. end
  274. else
  275. begin
  276. if (ld.ordtype<>u64bit) then
  277. inserttypeconv(left,u64inttype);
  278. if (rd.ordtype<>u64bit) then
  279. inserttypeconv(right,u64inttype);
  280. end;
  281. resultdef:=left.resultdef;
  282. end
  283. else
  284. { is there a larger than the native int? }
  285. if is_oversizedint(ld) or is_oversizedint(rd) then
  286. begin
  287. nd:=get_common_intdef(ld,rd,false);
  288. if (ld.ordtype<>nd.ordtype) then
  289. inserttypeconv(left,nd);
  290. if (rd.ordtype<>nd.ordtype) then
  291. inserttypeconv(right,nd);
  292. resultdef:=left.resultdef;
  293. end
  294. else
  295. { when mixing unsigned and signed native ints, convert everything to a larger signed type (JM) }
  296. if (is_nativeuint(rd) and
  297. is_signed(ld)) or
  298. (is_nativeuint(ld) and
  299. is_signed(rd)) then
  300. begin
  301. CGMessage(type_h_mixed_signed_unsigned);
  302. { get a signed int, larger than the native int }
  303. nd:=get_common_intdef(torddef(sinttype),torddef(uinttype),false);
  304. if (ld.ordtype<>nd.ordtype) then
  305. inserttypeconv(left,nd);
  306. if (rd.ordtype<>nd.ordtype) then
  307. inserttypeconv(right,nd);
  308. resultdef:=left.resultdef;
  309. end
  310. else
  311. begin
  312. { Make everything always default singed int }
  313. if not(rd.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  314. inserttypeconv(right,sinttype);
  315. if not(ld.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  316. inserttypeconv(left,sinttype);
  317. resultdef:=right.resultdef;
  318. end;
  319. { when the result is currency we need some extra code for
  320. division. this should not be done when the divn node is
  321. created internally }
  322. if (nodetype=divn) and
  323. not(nf_is_currency in flags) and
  324. is_currency(resultdef) then
  325. begin
  326. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  327. include(hp.flags,nf_is_currency);
  328. result:=hp;
  329. end;
  330. if (nodetype=modn) and (nf_isomod in flags) then
  331. begin
  332. result:=internalstatements(statements);
  333. else_block:=internalstatements(else_statements);
  334. result_data:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  335. { right <=0? }
  336. addstatement(statements,cifnode.create_internal(caddnode.create_internal(lten,right.getcopy,cordconstnode.create(0,resultdef,false)),
  337. { then: result:=left mod right }
  338. ccallnode.createintern('fpc_divbyzero',nil),
  339. nil
  340. ));
  341. { prepare else block }
  342. { result:=(-left) mod right }
  343. addstatement(else_statements,cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,cunaryminusnode.create(left.getcopy),right.getcopy)));
  344. { result<>0? }
  345. addstatement(else_statements,cifnode.create_internal(caddnode.create_internal(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)),
  346. { then: result:=right-result }
  347. cassignmentnode.create_internal(ctemprefnode.create(result_data),caddnode.create_internal(subn,right.getcopy,ctemprefnode.create(result_data))),
  348. nil
  349. ));
  350. addstatement(statements,result_data);
  351. { if left>=0 }
  352. addstatement(statements,cifnode.create_internal(caddnode.create_internal(gten,left.getcopy,cordconstnode.create(0,resultdef,false)),
  353. { then: result:=left mod right }
  354. cassignmentnode.create_internal(ctemprefnode.create(result_data),cmoddivnode.create(modn,left.getcopy,right.getcopy)),
  355. { else block }
  356. else_block
  357. ));
  358. addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
  359. addstatement(statements,ctemprefnode.create(result_data));
  360. end;
  361. end;
  362. function tmoddivnode.first_moddivint: tnode;
  363. {$ifdef cpuneedsdivhelper}
  364. var
  365. procname: string[31];
  366. begin
  367. result := nil;
  368. { otherwise create a call to a helper }
  369. if nodetype = divn then
  370. procname := 'fpc_div_'
  371. else
  372. procname := 'fpc_mod_';
  373. { only qword needs the unsigned code, the
  374. signed code is also used for currency }
  375. case torddef(resultdef).ordtype of
  376. u8bit:
  377. procname := procname + 'byte';
  378. s8bit:
  379. procname := procname + 'shortint';
  380. u16bit:
  381. procname := procname + 'word';
  382. s16bit:
  383. procname := procname + 'smallint';
  384. u32bit:
  385. procname := procname + 'dword';
  386. s32bit:
  387. procname := procname + 'longint'
  388. else
  389. internalerror(2015070501);
  390. end;
  391. result := ccallnode.createintern(procname,ccallparanode.create(left,
  392. ccallparanode.create(right,nil)));
  393. left := nil;
  394. right := nil;
  395. firstpass(result);
  396. if result.resultdef.typ<>orddef then
  397. internalerror(2013031701);
  398. if resultdef.typ<>orddef then
  399. internalerror(2013031701);
  400. if torddef(result.resultdef).ordtype <> torddef(resultdef).ordtype then
  401. inserttypeconv(result,resultdef);
  402. end;
  403. {$else cpuneedsdivhelper}
  404. begin
  405. result:=nil;
  406. end;
  407. {$endif cpuneedsdiv32helper}
  408. function tmoddivnode.first_moddiv64bitint: tnode;
  409. var
  410. procname: string[31];
  411. begin
  412. result := nil;
  413. { when currency is used set the result of the
  414. parameters to s64bit, so they are not converted }
  415. if is_currency(resultdef) then
  416. begin
  417. left.resultdef:=s64inttype;
  418. right.resultdef:=s64inttype;
  419. end;
  420. { otherwise create a call to a helper }
  421. if nodetype = divn then
  422. procname := 'fpc_div_'
  423. else
  424. procname := 'fpc_mod_';
  425. { only qword needs the unsigned code, the
  426. signed code is also used for currency }
  427. if is_signed(resultdef) then
  428. procname := procname + 'int64'
  429. else
  430. procname := procname + 'qword';
  431. result := ccallnode.createintern(procname,ccallparanode.create(left,
  432. ccallparanode.create(right,nil)));
  433. left := nil;
  434. right := nil;
  435. firstpass(result);
  436. end;
  437. function tmoddivnode.firstoptimize: tnode;
  438. var
  439. power,shiftval : longint;
  440. statements : tstatementnode;
  441. temp,resulttemp : ttempcreatenode;
  442. masknode : tnode;
  443. invertsign: Boolean;
  444. begin
  445. result := nil;
  446. { divide/mod a number by a constant which is a power of 2? }
  447. if (right.nodetype = ordconstn) and
  448. isabspowerof2(tordconstnode(right).value,power) and
  449. {$ifdef cpu64bitalu}
  450. { for 64 bit, we leave the optimization to the cg }
  451. (not is_signed(resultdef)) then
  452. {$else cpu64bitalu}
  453. (((nodetype=divn) and is_oversizedord(resultdef)) or
  454. (nodetype=modn) or
  455. not is_signed(resultdef)) then
  456. {$endif cpu64bitalu}
  457. begin
  458. if nodetype=divn then
  459. begin
  460. if is_signed(resultdef) then
  461. begin
  462. invertsign:=tordconstnode(right).value<0;
  463. if is_64bitint(left.resultdef) then
  464. if not (cs_opt_size in current_settings.optimizerswitches) then
  465. shiftval:=63
  466. else
  467. { the shift code is a lot bigger than the call to }
  468. { the divide helper }
  469. exit
  470. else
  471. shiftval:=left.resultdef.size*8-1;
  472. result:=internalstatements(statements);
  473. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  474. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  475. addstatement(statements,resulttemp);
  476. addstatement(statements,temp);
  477. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),
  478. left));
  479. left:=nil;
  480. { masknode is (sar(temp,shiftval) and ((1 shl power)-1))
  481. for power=1 (i.e. division by 2), masknode is simply (temp shr shiftval)}
  482. if power=1 then
  483. masknode:=
  484. cshlshrnode.create(shrn,
  485. ctemprefnode.create(temp),
  486. cordconstnode.create(shiftval,u8inttype,false)
  487. )
  488. else
  489. masknode:=
  490. caddnode.create(andn,
  491. cinlinenode.create(in_sar_x_y,false,
  492. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  493. ccallparanode.create(ctemprefnode.create(temp),nil))
  494. ),
  495. cordconstnode.create(tcgint((qword(1) shl power)-1),
  496. right.resultdef,false)
  497. );
  498. if invertsign then
  499. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  500. cunaryminusnode.create(
  501. cinlinenode.create(in_sar_x_y,false,
  502. ccallparanode.create(cordconstnode.create(power,u8inttype,false),
  503. ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
  504. masknode),nil
  505. )))))
  506. )
  507. else
  508. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  509. cinlinenode.create(in_sar_x_y,false,
  510. ccallparanode.create(cordconstnode.create(power,u8inttype,false),
  511. ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
  512. masknode),nil
  513. ))))
  514. );
  515. addstatement(statements,ctempdeletenode.create(temp));
  516. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  517. addstatement(statements,ctemprefnode.create(resulttemp));
  518. right.Free;
  519. end
  520. else
  521. begin
  522. tordconstnode(right).value:=power;
  523. result:=cshlshrnode.create(shrn,left,right)
  524. end;
  525. end
  526. else if is_signed(resultdef) then { signed modulus }
  527. begin
  528. if (cs_opt_size in current_settings.optimizerswitches) then
  529. exit;
  530. shiftval:=left.resultdef.size*8-1;
  531. tordconstnode(right).value.uvalue:=qword((qword(1) shl power)-1);
  532. result:=internalstatements(statements);
  533. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  534. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  535. addstatement(statements,resulttemp);
  536. addstatement(statements,temp);
  537. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),left));
  538. { mask:=sar(left,sizeof(left)*8-1) and ((1 shl power)-1); }
  539. if power=1 then
  540. masknode:=
  541. cshlshrnode.create(shrn,
  542. ctemprefnode.create(temp),
  543. cordconstnode.create(shiftval,u8inttype,false)
  544. )
  545. else
  546. masknode:=
  547. caddnode.create(andn,
  548. cinlinenode.create(in_sar_x_y,false,
  549. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  550. ccallparanode.create(ctemprefnode.create(temp),nil))
  551. ),
  552. cordconstnode.create(tcgint((qword(1) shl power)-1),
  553. right.resultdef,false)
  554. );
  555. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),masknode));
  556. { result:=((left+mask) and right)-mask; }
  557. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  558. caddnode.create(subn,
  559. caddnode.create(andn,
  560. right,
  561. caddnode.create(addn,
  562. ctemprefnode.create(temp),
  563. ctemprefnode.create(resulttemp))),
  564. ctemprefnode.create(resulttemp))
  565. ));
  566. addstatement(statements,ctempdeletenode.create(temp));
  567. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  568. addstatement(statements,ctemprefnode.create(resulttemp));
  569. end
  570. else
  571. begin
  572. tordconstnode(right).value.uvalue:=qword((qword(1) shl power)-1);
  573. result := caddnode.create(andn,left,right);
  574. end;
  575. { left and right are reused }
  576. left := nil;
  577. right := nil;
  578. firstpass(result);
  579. exit;
  580. end;
  581. end;
  582. function tmoddivnode.pass_1 : tnode;
  583. begin
  584. result:=nil;
  585. firstpass(left);
  586. firstpass(right);
  587. if codegenerror then
  588. exit;
  589. { Try to optimize mod/div }
  590. result := firstoptimize;
  591. if assigned(result) then
  592. exit;
  593. { 64bit }
  594. if use_moddiv64bitint_helper then
  595. begin
  596. result := first_moddiv64bitint;
  597. if assigned(result) then
  598. exit;
  599. expectloc:=LOC_REGISTER;
  600. end
  601. else
  602. begin
  603. result := first_moddivint;
  604. if assigned(result) then
  605. exit;
  606. end;
  607. expectloc:=LOC_REGISTER;
  608. end;
  609. {****************************************************************************
  610. TSHLSHRNODE
  611. ****************************************************************************}
  612. function tshlshrnode.simplify(forinline : boolean):tnode;
  613. var
  614. lvalue,rvalue : Tconstexprint;
  615. begin
  616. result:=nil;
  617. { constant folding }
  618. if is_constintnode(right) then
  619. begin
  620. if forinline then
  621. begin
  622. { shl/shr are unsigned operations, so cut off upper bits }
  623. case resultdef.size of
  624. 1,2,4:
  625. rvalue:=tordconstnode(right).value and byte($1f);
  626. 8:
  627. rvalue:=tordconstnode(right).value and byte($3f);
  628. else
  629. internalerror(2013122302);
  630. end;
  631. end
  632. else
  633. rvalue:=tordconstnode(right).value;
  634. if is_constintnode(left) then
  635. begin
  636. if forinline then
  637. begin
  638. { shl/shr are unsigned operations, so cut off upper bits }
  639. case resultdef.size of
  640. 1:
  641. lvalue:=tordconstnode(left).value and byte($ff);
  642. 2:
  643. lvalue:=tordconstnode(left).value and word($ffff);
  644. 4:
  645. lvalue:=tordconstnode(left).value and dword($ffffffff);
  646. 8:
  647. lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
  648. else
  649. internalerror(2013122301);
  650. end;
  651. end
  652. else
  653. lvalue:=tordconstnode(left).value;
  654. case nodetype of
  655. shrn:
  656. result:=create_simplified_ord_const(lvalue shr rvalue,resultdef,forinline);
  657. shln:
  658. result:=create_simplified_ord_const(lvalue shl rvalue,resultdef,forinline);
  659. end;
  660. end
  661. else if rvalue=0 then
  662. begin
  663. result:=left;
  664. left:=nil;
  665. end;
  666. end
  667. else if is_constintnode(left) then
  668. begin
  669. lvalue:=tordconstnode(left).value;
  670. { shl/shr are unsigned operations, so cut off upper bits }
  671. case resultdef.size of
  672. 1:
  673. lvalue:=tordconstnode(left).value and byte($ff);
  674. 2:
  675. lvalue:=tordconstnode(left).value and word($ffff);
  676. 4:
  677. lvalue:=tordconstnode(left).value and dword($ffffffff);
  678. 8:
  679. lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
  680. else
  681. internalerror(2013122301);
  682. end;
  683. { '0 shl x' and '0 shr x' are 0 }
  684. if (lvalue=0) and
  685. ((cs_opt_level4 in current_settings.optimizerswitches) or
  686. not might_have_sideeffects(right)) then
  687. result:=cordconstnode.create(0,resultdef,true);
  688. end;
  689. end;
  690. function tshlshrnode.pass_typecheck:tnode;
  691. var
  692. t : tnode;
  693. begin
  694. result:=nil;
  695. typecheckpass(left);
  696. typecheckpass(right);
  697. { avoid any problems with type parameters later on }
  698. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  699. begin
  700. resultdef:=cundefinedtype;
  701. exit;
  702. end;
  703. set_varstate(right,vs_read,[vsf_must_be_valid]);
  704. set_varstate(left,vs_read,[vsf_must_be_valid]);
  705. if codegenerror then
  706. exit;
  707. { tp procvar support }
  708. maybe_call_procvar(left,true);
  709. maybe_call_procvar(right,true);
  710. { allow operator overloading }
  711. t:=self;
  712. if isbinaryoverloaded(t) then
  713. begin
  714. result:=t;
  715. exit;
  716. end;
  717. { calculations for ordinals < 32 bit have to be done in
  718. 32 bit for backwards compatibility. That way 'shl 33' is
  719. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  720. if (not is_64bit(left.resultdef)) and
  721. (torddef(left.resultdef).ordtype<>u32bit) then
  722. begin
  723. { keep singness of orignal type }
  724. if is_signed(left.resultdef) then
  725. begin
  726. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  727. inserttypeconv(left,s32inttype)
  728. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  729. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(sinttype),true));
  730. {$else}
  731. internalerror(2013031301);
  732. {$endif}
  733. end
  734. else
  735. begin
  736. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  737. inserttypeconv(left,u32inttype);
  738. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  739. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(uinttype),true));
  740. {$else}
  741. internalerror(2013031301);
  742. {$endif}
  743. end
  744. end;
  745. inserttypeconv(right,sinttype);
  746. resultdef:=left.resultdef;
  747. result:=simplify(false);
  748. if assigned(result) then
  749. exit;
  750. end;
  751. {$ifndef cpu64bitalu}
  752. function tshlshrnode.first_shlshr64bitint: tnode;
  753. var
  754. procname: string[31];
  755. begin
  756. result := nil;
  757. { Normally already done below, but called again,
  758. just in case it is called directly }
  759. firstpass(left);
  760. { otherwise create a call to a helper }
  761. if is_signed(left.resultdef) then
  762. procname:='int64'
  763. else
  764. procname:='qword';
  765. if nodetype = shln then
  766. procname := 'fpc_shl_'+procname
  767. else
  768. procname := 'fpc_shr_'+procname;
  769. { this order of parameters works at least for the arm,
  770. however it should work for any calling conventions (FK) }
  771. result := ccallnode.createintern(procname,ccallparanode.create(right,
  772. ccallparanode.create(left,nil)));
  773. left := nil;
  774. right := nil;
  775. firstpass(result);
  776. end;
  777. {$endif not cpu64bitalu}
  778. function tshlshrnode.pass_1 : tnode;
  779. var
  780. regs : longint;
  781. begin
  782. result:=nil;
  783. firstpass(left);
  784. firstpass(right);
  785. if codegenerror then
  786. exit;
  787. {$ifndef cpu64bitalu}
  788. { 64 bit ints have their own shift handling }
  789. if is_64bit(left.resultdef) then
  790. begin
  791. result := first_shlshr64bitint;
  792. if assigned(result) then
  793. exit;
  794. regs:=2;
  795. end
  796. else
  797. {$endif not cpu64bitalu}
  798. begin
  799. regs:=1
  800. end;
  801. if (right.nodetype<>ordconstn) then
  802. inc(regs);
  803. expectloc:=LOC_REGISTER;
  804. end;
  805. {****************************************************************************
  806. TUNARYMINUSNODE
  807. ****************************************************************************}
  808. constructor tunaryminusnode.create(expr : tnode);
  809. begin
  810. inherited create(unaryminusn,expr);
  811. end;
  812. function tunaryminusnode.simplify(forinline : boolean):tnode;
  813. begin
  814. result:=nil;
  815. { constant folding }
  816. if is_constintnode(left) then
  817. begin
  818. result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
  819. exit;
  820. end;
  821. if is_constrealnode(left) then
  822. begin
  823. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  824. { Avoid integer overflow on x86_64 CPU for currency value }
  825. { i386 uses fildll/fchs/fistll instructions which never seem
  826. to raise any coprocessor flags .. }
  827. {$push}{$Q-}
  828. trealconstnode(left).value_currency:=-trealconstnode(left).value_currency;
  829. result:=left;
  830. {$pop}
  831. left:=nil;
  832. exit;
  833. end;
  834. end;
  835. function tunaryminusnode.pass_typecheck : tnode;
  836. var
  837. t : tnode;
  838. begin
  839. result:=nil;
  840. typecheckpass(left);
  841. { avoid any problems with type parameters later on }
  842. if is_typeparam(left.resultdef) then
  843. begin
  844. resultdef:=cundefinedtype;
  845. exit;
  846. end;
  847. set_varstate(left,vs_read,[vsf_must_be_valid]);
  848. if codegenerror then
  849. exit;
  850. result:=simplify(false);
  851. if assigned(result) then
  852. exit;
  853. resultdef:=left.resultdef;
  854. if (left.resultdef.typ=floatdef) or
  855. is_currency(left.resultdef) then
  856. begin
  857. end
  858. {$ifdef SUPPORT_MMX}
  859. else if (cs_mmx in current_settings.localswitches) and
  860. is_mmx_able_array(left.resultdef) then
  861. begin
  862. { if saturation is on, left.resultdef isn't
  863. "mmx able" (FK)
  864. if (cs_mmx_saturation in current_settings.localswitches^) and
  865. (torddef(tarraydef(resultdef).definition).typ in
  866. [s32bit,u32bit]) then
  867. CGMessage(type_e_mismatch);
  868. }
  869. end
  870. {$endif SUPPORT_MMX}
  871. else if is_oversizedord(left.resultdef) then
  872. begin
  873. if is_64bit(left.resultdef) then
  874. inserttypeconv(left,s64inttype)
  875. else if is_32bit(left.resultdef) then
  876. inserttypeconv(left,s32inttype)
  877. else if is_16bit(left.resultdef) then
  878. inserttypeconv(left,s16inttype)
  879. else
  880. internalerror(2013040701);
  881. resultdef:=left.resultdef;
  882. end
  883. else if (left.resultdef.typ=orddef) then
  884. begin
  885. inserttypeconv(left,sinttype);
  886. resultdef:=left.resultdef
  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. { generic code }
  901. { overridden by: }
  902. { i386 }
  903. function tunaryminusnode.pass_1 : tnode;
  904. var
  905. procname: string[31];
  906. begin
  907. result:=nil;
  908. firstpass(left);
  909. if codegenerror then
  910. exit;
  911. if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then
  912. begin
  913. if not(target_info.system in systems_wince) then
  914. begin
  915. expectloc:=LOC_REGISTER;
  916. exit;
  917. end
  918. else
  919. begin
  920. case tfloatdef(resultdef).floattype of
  921. s32real:
  922. procname:='negs';
  923. s64real:
  924. procname:='negd';
  925. {!!! not yet implemented
  926. s128real:
  927. }
  928. else
  929. internalerror(2005082802);
  930. end;
  931. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  932. end;
  933. left:=nil;
  934. end
  935. else
  936. begin
  937. if (left.resultdef.typ=floatdef) then
  938. expectloc:=LOC_FPUREGISTER
  939. {$ifdef SUPPORT_MMX}
  940. else if (cs_mmx in current_settings.localswitches) and
  941. is_mmx_able_array(left.resultdef) then
  942. expectloc:=LOC_MMXREGISTER
  943. {$endif SUPPORT_MMX}
  944. else if (left.resultdef.typ=orddef) then
  945. expectloc:=LOC_REGISTER;
  946. end;
  947. end;
  948. {****************************************************************************
  949. TUNARYPLUSNODE
  950. ****************************************************************************}
  951. constructor tunaryplusnode.create(expr: tnode);
  952. begin
  953. inherited create(unaryplusn,expr);
  954. end;
  955. function tunaryplusnode.pass_1: tnode;
  956. begin
  957. result:=nil;
  958. { can never happen because all the conversions happen
  959. in pass_typecheck }
  960. internalerror(201012250);
  961. end;
  962. function tunaryplusnode.pass_typecheck: tnode;
  963. var
  964. t:tnode;
  965. begin
  966. result:=nil;
  967. typecheckpass(left);
  968. { avoid any problems with type parameters later on }
  969. if is_typeparam(left.resultdef) then
  970. begin
  971. resultdef:=cundefinedtype;
  972. exit;
  973. end;
  974. set_varstate(left,vs_read,[vsf_must_be_valid]);
  975. if codegenerror then
  976. exit;
  977. if is_constintnode(left) or
  978. is_constrealnode(left) or
  979. (left.resultdef.typ=floatdef) or
  980. is_currency(left.resultdef)
  981. {$ifdef SUPPORT_MMX}
  982. or ((cs_mmx in current_settings.localswitches) and
  983. is_mmx_able_array(left.resultdef))
  984. {$endif SUPPORT_MMX}
  985. then
  986. begin
  987. result:=left;
  988. left:=nil;
  989. end
  990. else if is_oversizedord(left.resultdef) then
  991. begin
  992. if is_64bit(left.resultdef) then
  993. inserttypeconv(left,s64inttype)
  994. else if is_32bit(left.resultdef) then
  995. inserttypeconv(left,s32inttype)
  996. else if is_16bit(left.resultdef) then
  997. inserttypeconv(left,s16inttype)
  998. else
  999. internalerror(2013040702);
  1000. result:=left;
  1001. left:=nil;
  1002. end
  1003. else if (left.resultdef.typ=orddef) then
  1004. begin
  1005. inserttypeconv(left,sinttype);
  1006. result:=left;
  1007. left:=nil;
  1008. end
  1009. else
  1010. begin
  1011. { allow operator overloading }
  1012. t:=self;
  1013. if isunaryoverloaded(t) then
  1014. begin
  1015. result:=t;
  1016. exit;
  1017. end;
  1018. CGMessage(type_e_mismatch);
  1019. end;
  1020. end;
  1021. {****************************************************************************
  1022. TNOTNODE
  1023. ****************************************************************************}
  1024. const
  1025. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  1026. gten,gtn,lten,ltn,unequaln,equaln
  1027. );
  1028. constructor tnotnode.create(expr : tnode);
  1029. begin
  1030. inherited create(notn,expr);
  1031. end;
  1032. function tnotnode.simplify(forinline : boolean):tnode;
  1033. var
  1034. v : tconstexprint;
  1035. t : tnode;
  1036. def : tdef;
  1037. begin
  1038. result:=nil;
  1039. { Try optmimizing ourself away }
  1040. if left.nodetype=notn then
  1041. begin
  1042. { Double not. Remove both }
  1043. result:=Tnotnode(left).left;
  1044. tnotnode(left).left:=nil;
  1045. exit;
  1046. end;
  1047. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  1048. begin
  1049. { Not of boolean expression. Turn around the operator and remove
  1050. the not. This is not allowed for sets with the gten/lten,
  1051. because there is no ltn/gtn support }
  1052. if (taddnode(left).left.resultdef.typ<>setdef) or
  1053. (left.nodetype in [equaln,unequaln]) then
  1054. begin
  1055. result:=left;
  1056. left.nodetype:=boolean_reverse[left.nodetype];
  1057. left:=nil;
  1058. exit;
  1059. end;
  1060. end;
  1061. { constant folding }
  1062. if (left.nodetype=ordconstn) then
  1063. begin
  1064. v:=tordconstnode(left).value;
  1065. def:=left.resultdef;
  1066. case torddef(left.resultdef).ordtype of
  1067. pasbool8,
  1068. pasbool16,
  1069. pasbool32,
  1070. pasbool64:
  1071. v:=byte(not(boolean(int64(v))));
  1072. bool8bit,
  1073. bool16bit,
  1074. bool32bit,
  1075. bool64bit:
  1076. begin
  1077. if v=0 then
  1078. v:=-1
  1079. else
  1080. v:=0;
  1081. end;
  1082. uchar,
  1083. uwidechar,
  1084. u8bit,
  1085. s8bit,
  1086. u16bit,
  1087. s16bit,
  1088. s32bit,
  1089. u32bit,
  1090. s64bit,
  1091. u64bit:
  1092. begin
  1093. { unsigned, equal or bigger than the native int size? }
  1094. if (torddef(left.resultdef).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
  1095. (is_nativeord(left.resultdef) or is_oversizedord(left.resultdef)) then
  1096. begin
  1097. { Delphi-compatible: not dword = dword (not word = longint) }
  1098. { Extension: not qword = qword }
  1099. v:=qword(not qword(v));
  1100. { will be truncated by the ordconstnode for u32bit }
  1101. end
  1102. else
  1103. begin
  1104. v:=int64(not int64(v));
  1105. def:=get_common_intdef(torddef(left.resultdef),torddef(sinttype),false);
  1106. end;
  1107. end;
  1108. else
  1109. CGMessage(type_e_mismatch);
  1110. end;
  1111. { not-nodes are not range checked by the code generator -> also
  1112. don't range check while inlining; the resultdef is a bit tricky
  1113. though: the node's resultdef gets changed in most cases compared
  1114. to left, but the not-operation itself is caried out in the code
  1115. generator using the size of left
  1116. }
  1117. if not(forinline) then
  1118. t:=cordconstnode.create(v,def,false)
  1119. else
  1120. begin
  1121. { cut off the value if necessary }
  1122. t:=cordconstnode.create(v,left.resultdef,false);
  1123. { now convert to node's resultdef }
  1124. inserttypeconv_explicit(t,def);
  1125. end;
  1126. result:=t;
  1127. exit;
  1128. end;
  1129. end;
  1130. function tnotnode.pass_typecheck : tnode;
  1131. var
  1132. t : tnode;
  1133. begin
  1134. result:=nil;
  1135. typecheckpass(left);
  1136. { avoid any problems with type parameters later on }
  1137. if is_typeparam(left.resultdef) then
  1138. begin
  1139. resultdef:=cundefinedtype;
  1140. exit;
  1141. end;
  1142. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1143. if codegenerror then
  1144. exit;
  1145. { tp procvar support }
  1146. maybe_call_procvar(left,true);
  1147. resultdef:=left.resultdef;
  1148. result:=simplify(false);
  1149. if assigned(result) then
  1150. exit;
  1151. if is_boolean(resultdef) then
  1152. begin
  1153. end
  1154. else
  1155. {$ifdef SUPPORT_MMX}
  1156. if (cs_mmx in current_settings.localswitches) and
  1157. is_mmx_able_array(left.resultdef) then
  1158. begin
  1159. end
  1160. else
  1161. {$endif SUPPORT_MMX}
  1162. {$ifndef cpu64bitaddr}
  1163. if is_64bitint(left.resultdef) then
  1164. begin
  1165. end
  1166. else
  1167. {$endif not cpu64bitaddr}
  1168. if is_integer(left.resultdef) then
  1169. begin
  1170. end
  1171. else
  1172. begin
  1173. { allow operator overloading }
  1174. t:=self;
  1175. if isunaryoverloaded(t) then
  1176. begin
  1177. result:=t;
  1178. exit;
  1179. end;
  1180. CGMessage(type_e_mismatch);
  1181. end;
  1182. end;
  1183. function tnotnode.pass_1 : tnode;
  1184. begin
  1185. result:=nil;
  1186. firstpass(left);
  1187. if codegenerror then
  1188. exit;
  1189. expectloc:=left.expectloc;
  1190. if is_boolean(resultdef) then
  1191. begin
  1192. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1193. expectloc:=LOC_REGISTER;
  1194. { before loading it into flags we need to load it into
  1195. a register thus 1 register is need PM }
  1196. {$ifdef cpuflags}
  1197. if left.expectloc<>LOC_JUMP then
  1198. expectloc:=LOC_FLAGS;
  1199. {$endif def cpuflags}
  1200. end
  1201. else
  1202. {$ifdef SUPPORT_MMX}
  1203. if (cs_mmx in current_settings.localswitches) and
  1204. is_mmx_able_array(left.resultdef) then
  1205. expectloc:=LOC_MMXREGISTER
  1206. else
  1207. {$endif SUPPORT_MMX}
  1208. {$ifndef cpu64bitalu}
  1209. if is_64bit(left.resultdef) then
  1210. begin
  1211. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1212. expectloc:=LOC_REGISTER;
  1213. end
  1214. else
  1215. {$endif not cpu64bitalu}
  1216. if is_integer(left.resultdef) then
  1217. expectloc:=LOC_REGISTER;
  1218. end;
  1219. {$ifdef state_tracking}
  1220. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  1221. begin
  1222. track_state_pass:=true;
  1223. if left.track_state_pass(exec_known) then
  1224. begin
  1225. left.resultdef:=nil;
  1226. do_typecheckpass(left);
  1227. end;
  1228. end;
  1229. {$endif}
  1230. end.