nmat.pas 43 KB

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