nmat.pas 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290
  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. { 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(caddnode.create(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(caddnode.create(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)),
  346. { then: result:=right-result }
  347. cassignmentnode.create(ctemprefnode.create(result_data),caddnode.create(subn,right.getcopy,ctemprefnode.create(result_data))),
  348. nil
  349. ));
  350. addstatement(statements,result_data);
  351. { if left>=0 }
  352. addstatement(statements,cifnode.create(caddnode.create(gten,left.getcopy,cordconstnode.create(0,resultdef,false)),
  353. { then: result:=left mod right }
  354. cassignmentnode.create(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 cpuneedsdiv32helper}
  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. if is_signed(resultdef) then
  376. procname := procname + 'longint'
  377. else
  378. procname := procname + 'dword';
  379. result := ccallnode.createintern(procname,ccallparanode.create(left,
  380. ccallparanode.create(right,nil)));
  381. left := nil;
  382. right := nil;
  383. firstpass(result);
  384. if result.resultdef.typ<>orddef then
  385. internalerror(2013031701);
  386. if resultdef.typ<>orddef then
  387. internalerror(2013031701);
  388. if torddef(result.resultdef).ordtype <> torddef(resultdef).ordtype then
  389. inserttypeconv(result,resultdef);
  390. end;
  391. {$else cpuneedsdiv32helper}
  392. begin
  393. result:=nil;
  394. end;
  395. {$endif cpuneedsdiv32helper}
  396. function tmoddivnode.first_moddiv64bitint: tnode;
  397. var
  398. procname: string[31];
  399. begin
  400. result := nil;
  401. { when currency is used set the result of the
  402. parameters to s64bit, so they are not converted }
  403. if is_currency(resultdef) then
  404. begin
  405. left.resultdef:=s64inttype;
  406. right.resultdef:=s64inttype;
  407. end;
  408. { otherwise create a call to a helper }
  409. if nodetype = divn then
  410. procname := 'fpc_div_'
  411. else
  412. procname := 'fpc_mod_';
  413. { only qword needs the unsigned code, the
  414. signed code is also used for currency }
  415. if is_signed(resultdef) then
  416. procname := procname + 'int64'
  417. else
  418. procname := procname + 'qword';
  419. result := ccallnode.createintern(procname,ccallparanode.create(left,
  420. ccallparanode.create(right,nil)));
  421. left := nil;
  422. right := nil;
  423. firstpass(result);
  424. end;
  425. function tmoddivnode.firstoptimize: tnode;
  426. var
  427. power,shiftval : longint;
  428. statements : tstatementnode;
  429. temp,resulttemp : ttempcreatenode;
  430. begin
  431. result := nil;
  432. { divide/mod a number by a constant which is a power of 2? }
  433. if (right.nodetype = ordconstn) and
  434. ispowerof2(tordconstnode(right).value,power) and
  435. {$ifdef cpu64bitalu}
  436. { for 64 bit, we leave the optimization to the cg }
  437. (not is_signed(resultdef)) then
  438. {$else cpu64bitalu}
  439. (((nodetype=divn) and is_64bit(resultdef)) or
  440. (nodetype=modn) or
  441. not is_signed(resultdef)) then
  442. {$endif cpu64bitalu}
  443. begin
  444. if nodetype=divn then
  445. begin
  446. if is_signed(resultdef) then
  447. begin
  448. if is_64bitint(left.resultdef) then
  449. if not (cs_opt_size in current_settings.optimizerswitches) then
  450. shiftval:=63
  451. else
  452. { the shift code is a lot bigger than the call to }
  453. { the divide helper }
  454. exit
  455. else
  456. shiftval:=31;
  457. result:=internalstatements(statements);
  458. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  459. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  460. addstatement(statements,resulttemp);
  461. addstatement(statements,temp);
  462. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),
  463. left));
  464. left:=nil;
  465. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  466. cinlinenode.create(in_sar_x_y,false,
  467. ccallparanode.create(cordconstnode.create(power,u8inttype,false),
  468. ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
  469. caddnode.create(andn,
  470. cinlinenode.create(in_sar_x_y,false,
  471. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  472. ccallparanode.create(ctemprefnode.create(temp),nil))
  473. ),
  474. cordconstnode.create(tordconstnode(right).value-1,
  475. right.resultdef,false)
  476. )),nil
  477. ))))
  478. );
  479. addstatement(statements,ctempdeletenode.create(temp));
  480. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  481. addstatement(statements,ctemprefnode.create(resulttemp));
  482. end
  483. else
  484. begin
  485. tordconstnode(right).value:=power;
  486. result:=cshlshrnode.create(shrn,left,right)
  487. end;
  488. end
  489. else if is_signed(resultdef) then { signed modulus }
  490. begin
  491. if (cs_opt_size in current_settings.optimizerswitches) then
  492. exit;
  493. shiftval:=left.resultdef.size*8-1;
  494. dec(tordconstnode(right).value.uvalue);
  495. result:=internalstatements(statements);
  496. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  497. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  498. addstatement(statements,resulttemp);
  499. addstatement(statements,temp);
  500. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),left));
  501. { sign:=sar(left,sizeof(left)*8-1); }
  502. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  503. cinlinenode.create(in_sar_x_y,false,
  504. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  505. ccallparanode.create(ctemprefnode.create(temp),nil)
  506. )
  507. )));
  508. { result:=((((left xor sign)-sign) and right) xor sign)-sign; }
  509. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  510. caddnode.create(subn,
  511. caddnode.create(xorn,
  512. caddnode.create(andn,
  513. right,
  514. caddnode.create(subn,
  515. caddnode.create(xorn,
  516. ctemprefnode.create(resulttemp),
  517. ctemprefnode.create(temp)),
  518. ctemprefnode.create(resulttemp))
  519. ),
  520. ctemprefnode.create(resulttemp)
  521. ),
  522. ctemprefnode.create(resulttemp))
  523. ));
  524. addstatement(statements,ctempdeletenode.create(temp));
  525. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  526. addstatement(statements,ctemprefnode.create(resulttemp));
  527. end
  528. else
  529. begin
  530. dec(tordconstnode(right).value.uvalue);
  531. result := caddnode.create(andn,left,right);
  532. end;
  533. { left and right are reused }
  534. left := nil;
  535. right := nil;
  536. firstpass(result);
  537. exit;
  538. end;
  539. end;
  540. function tmoddivnode.pass_1 : tnode;
  541. begin
  542. result:=nil;
  543. firstpass(left);
  544. firstpass(right);
  545. if codegenerror then
  546. exit;
  547. { Try to optimize mod/div }
  548. result := firstoptimize;
  549. if assigned(result) then
  550. exit;
  551. { 64bit }
  552. if use_moddiv64bitint_helper then
  553. begin
  554. result := first_moddiv64bitint;
  555. if assigned(result) then
  556. exit;
  557. expectloc:=LOC_REGISTER;
  558. end
  559. else
  560. begin
  561. result := first_moddivint;
  562. if assigned(result) then
  563. exit;
  564. end;
  565. expectloc:=LOC_REGISTER;
  566. end;
  567. {****************************************************************************
  568. TSHLSHRNODE
  569. ****************************************************************************}
  570. function tshlshrnode.simplify(forinline : boolean):tnode;
  571. var
  572. lvalue,rvalue : Tconstexprint;
  573. begin
  574. result:=nil;
  575. { constant folding }
  576. if is_constintnode(right) then
  577. begin
  578. if forinline then
  579. begin
  580. { shl/shr are unsigned operations, so cut off upper bits }
  581. case resultdef.size of
  582. 1,2,4:
  583. rvalue:=tordconstnode(right).value and byte($1f);
  584. 8:
  585. rvalue:=tordconstnode(right).value and byte($3f);
  586. else
  587. internalerror(2013122302);
  588. end;
  589. end
  590. else
  591. rvalue:=tordconstnode(right).value;
  592. if is_constintnode(left) then
  593. begin
  594. if forinline then
  595. begin
  596. { shl/shr are unsigned operations, so cut off upper bits }
  597. case resultdef.size of
  598. 1:
  599. lvalue:=tordconstnode(left).value and byte($ff);
  600. 2:
  601. lvalue:=tordconstnode(left).value and word($ffff);
  602. 4:
  603. lvalue:=tordconstnode(left).value and dword($ffffffff);
  604. 8:
  605. lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
  606. else
  607. internalerror(2013122301);
  608. end;
  609. end
  610. else
  611. lvalue:=tordconstnode(left).value;
  612. case nodetype of
  613. shrn:
  614. result:=create_simplified_ord_const(lvalue shr rvalue,resultdef,forinline);
  615. shln:
  616. result:=create_simplified_ord_const(lvalue shl rvalue,resultdef,forinline);
  617. end;
  618. end
  619. else if rvalue=0 then
  620. begin
  621. result:=left;
  622. left:=nil;
  623. end;
  624. end;
  625. end;
  626. function tshlshrnode.pass_typecheck:tnode;
  627. var
  628. t : tnode;
  629. begin
  630. result:=nil;
  631. typecheckpass(left);
  632. typecheckpass(right);
  633. { avoid any problems with type parameters later on }
  634. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  635. begin
  636. resultdef:=cundefinedtype;
  637. exit;
  638. end;
  639. set_varstate(right,vs_read,[vsf_must_be_valid]);
  640. set_varstate(left,vs_read,[vsf_must_be_valid]);
  641. if codegenerror then
  642. exit;
  643. { tp procvar support }
  644. maybe_call_procvar(left,true);
  645. maybe_call_procvar(right,true);
  646. { allow operator overloading }
  647. t:=self;
  648. if isbinaryoverloaded(t) then
  649. begin
  650. result:=t;
  651. exit;
  652. end;
  653. { calculations for ordinals < 32 bit have to be done in
  654. 32 bit for backwards compatibility. That way 'shl 33' is
  655. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  656. if (not is_64bit(left.resultdef)) and
  657. (torddef(left.resultdef).ordtype<>u32bit) then
  658. begin
  659. { keep singness of orignal type }
  660. if is_signed(left.resultdef) then
  661. begin
  662. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  663. inserttypeconv(left,s32inttype)
  664. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  665. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(sinttype),true));
  666. {$else}
  667. internalerror(2013031301);
  668. {$endif}
  669. end
  670. else
  671. begin
  672. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  673. inserttypeconv(left,u32inttype);
  674. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  675. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(uinttype),true));
  676. {$else}
  677. internalerror(2013031301);
  678. {$endif}
  679. end
  680. end;
  681. inserttypeconv(right,sinttype);
  682. resultdef:=left.resultdef;
  683. result:=simplify(false);
  684. if assigned(result) then
  685. exit;
  686. end;
  687. {$ifndef cpu64bitalu}
  688. function tshlshrnode.first_shlshr64bitint: tnode;
  689. var
  690. procname: string[31];
  691. begin
  692. result := nil;
  693. { Normally already done below, but called again,
  694. just in case it is called directly }
  695. firstpass(left);
  696. { otherwise create a call to a helper }
  697. if is_signed(left.resultdef) then
  698. procname:='int64'
  699. else
  700. procname:='qword';
  701. if nodetype = shln then
  702. procname := 'fpc_shl_'+procname
  703. else
  704. procname := 'fpc_shr_'+procname;
  705. { this order of parameters works at least for the arm,
  706. however it should work for any calling conventions (FK) }
  707. result := ccallnode.createintern(procname,ccallparanode.create(right,
  708. ccallparanode.create(left,nil)));
  709. left := nil;
  710. right := nil;
  711. firstpass(result);
  712. end;
  713. {$endif not cpu64bitalu}
  714. function tshlshrnode.pass_1 : tnode;
  715. var
  716. regs : longint;
  717. begin
  718. result:=nil;
  719. firstpass(left);
  720. firstpass(right);
  721. if codegenerror then
  722. exit;
  723. {$ifndef cpu64bitalu}
  724. { 64 bit ints have their own shift handling }
  725. if is_64bit(left.resultdef) then
  726. begin
  727. result := first_shlshr64bitint;
  728. if assigned(result) then
  729. exit;
  730. regs:=2;
  731. end
  732. else
  733. {$endif not cpu64bitalu}
  734. begin
  735. regs:=1
  736. end;
  737. if (right.nodetype<>ordconstn) then
  738. inc(regs);
  739. expectloc:=LOC_REGISTER;
  740. end;
  741. {****************************************************************************
  742. TUNARYMINUSNODE
  743. ****************************************************************************}
  744. constructor tunaryminusnode.create(expr : tnode);
  745. begin
  746. inherited create(unaryminusn,expr);
  747. end;
  748. function tunaryminusnode.simplify(forinline : boolean):tnode;
  749. begin
  750. result:=nil;
  751. { constant folding }
  752. if is_constintnode(left) then
  753. begin
  754. result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
  755. exit;
  756. end;
  757. if is_constrealnode(left) then
  758. begin
  759. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  760. trealconstnode(left).value_currency:=-trealconstnode(left).value_currency;
  761. result:=left;
  762. left:=nil;
  763. exit;
  764. end;
  765. end;
  766. function tunaryminusnode.pass_typecheck : tnode;
  767. var
  768. t : tnode;
  769. begin
  770. result:=nil;
  771. typecheckpass(left);
  772. { avoid any problems with type parameters later on }
  773. if is_typeparam(left.resultdef) then
  774. begin
  775. resultdef:=cundefinedtype;
  776. exit;
  777. end;
  778. set_varstate(left,vs_read,[vsf_must_be_valid]);
  779. if codegenerror then
  780. exit;
  781. result:=simplify(false);
  782. if assigned(result) then
  783. exit;
  784. resultdef:=left.resultdef;
  785. if (left.resultdef.typ=floatdef) or
  786. is_currency(left.resultdef) then
  787. begin
  788. end
  789. {$ifdef SUPPORT_MMX}
  790. else if (cs_mmx in current_settings.localswitches) and
  791. is_mmx_able_array(left.resultdef) then
  792. begin
  793. { if saturation is on, left.resultdef isn't
  794. "mmx able" (FK)
  795. if (cs_mmx_saturation in current_settings.localswitches^) and
  796. (torddef(tarraydef(resultdef).definition).typ in
  797. [s32bit,u32bit]) then
  798. CGMessage(type_e_mismatch);
  799. }
  800. end
  801. {$endif SUPPORT_MMX}
  802. else if is_oversizedord(left.resultdef) then
  803. begin
  804. if is_64bit(left.resultdef) then
  805. inserttypeconv(left,s64inttype)
  806. else if is_32bit(left.resultdef) then
  807. inserttypeconv(left,s32inttype)
  808. else if is_16bit(left.resultdef) then
  809. inserttypeconv(left,s16inttype)
  810. else
  811. internalerror(2013040701);
  812. resultdef:=left.resultdef;
  813. end
  814. else if (left.resultdef.typ=orddef) then
  815. begin
  816. inserttypeconv(left,sinttype);
  817. resultdef:=left.resultdef
  818. end
  819. else
  820. begin
  821. { allow operator overloading }
  822. t:=self;
  823. if isunaryoverloaded(t) then
  824. begin
  825. result:=t;
  826. exit;
  827. end;
  828. CGMessage(type_e_mismatch);
  829. end;
  830. end;
  831. { generic code }
  832. { overridden by: }
  833. { i386 }
  834. function tunaryminusnode.pass_1 : tnode;
  835. var
  836. procname: string[31];
  837. fdef : tdef;
  838. begin
  839. result:=nil;
  840. firstpass(left);
  841. if codegenerror then
  842. exit;
  843. if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then
  844. begin
  845. if not(target_info.system in systems_wince) then
  846. begin
  847. expectloc:=LOC_REGISTER;
  848. exit;
  849. end
  850. else
  851. begin
  852. case tfloatdef(resultdef).floattype of
  853. s32real:
  854. procname:='NEGS';
  855. s64real:
  856. procname:='NEGD';
  857. {!!! not yet implemented
  858. s128real:
  859. }
  860. else
  861. internalerror(2005082802);
  862. end;
  863. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  864. end;
  865. left:=nil;
  866. end
  867. else
  868. begin
  869. if (left.resultdef.typ=floatdef) then
  870. expectloc:=LOC_FPUREGISTER
  871. {$ifdef SUPPORT_MMX}
  872. else if (cs_mmx in current_settings.localswitches) and
  873. is_mmx_able_array(left.resultdef) then
  874. expectloc:=LOC_MMXREGISTER
  875. {$endif SUPPORT_MMX}
  876. else if (left.resultdef.typ=orddef) then
  877. expectloc:=LOC_REGISTER;
  878. end;
  879. end;
  880. {****************************************************************************
  881. TUNARYPLUSNODE
  882. ****************************************************************************}
  883. constructor tunaryplusnode.create(expr: tnode);
  884. begin
  885. inherited create(unaryplusn,expr);
  886. end;
  887. function tunaryplusnode.pass_1: tnode;
  888. begin
  889. result:=nil;
  890. { can never happen because all the conversions happen
  891. in pass_typecheck }
  892. internalerror(201012250);
  893. end;
  894. function tunaryplusnode.pass_typecheck: tnode;
  895. var
  896. t:tnode;
  897. begin
  898. result:=nil;
  899. typecheckpass(left);
  900. { avoid any problems with type parameters later on }
  901. if is_typeparam(left.resultdef) then
  902. begin
  903. resultdef:=cundefinedtype;
  904. exit;
  905. end;
  906. set_varstate(left,vs_read,[vsf_must_be_valid]);
  907. if codegenerror then
  908. exit;
  909. if is_constintnode(left) or
  910. is_constrealnode(left) or
  911. (left.resultdef.typ=floatdef) or
  912. is_currency(left.resultdef)
  913. {$ifdef SUPPORT_MMX}
  914. or ((cs_mmx in current_settings.localswitches) and
  915. is_mmx_able_array(left.resultdef))
  916. {$endif SUPPORT_MMX}
  917. then
  918. begin
  919. result:=left;
  920. left:=nil;
  921. end
  922. else if is_oversizedord(left.resultdef) then
  923. begin
  924. if is_64bit(left.resultdef) then
  925. inserttypeconv(left,s64inttype)
  926. else if is_32bit(left.resultdef) then
  927. inserttypeconv(left,s32inttype)
  928. else if is_16bit(left.resultdef) then
  929. inserttypeconv(left,s16inttype)
  930. else
  931. internalerror(2013040702);
  932. result:=left;
  933. left:=nil;
  934. end
  935. else if (left.resultdef.typ=orddef) then
  936. begin
  937. inserttypeconv(left,sinttype);
  938. result:=left;
  939. left:=nil;
  940. end
  941. else
  942. begin
  943. { allow operator overloading }
  944. t:=self;
  945. if isunaryoverloaded(t) then
  946. begin
  947. result:=t;
  948. exit;
  949. end;
  950. CGMessage(type_e_mismatch);
  951. end;
  952. end;
  953. {****************************************************************************
  954. TNOTNODE
  955. ****************************************************************************}
  956. const
  957. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  958. gten,gtn,lten,ltn,unequaln,equaln
  959. );
  960. constructor tnotnode.create(expr : tnode);
  961. begin
  962. inherited create(notn,expr);
  963. end;
  964. function tnotnode.simplify(forinline : boolean):tnode;
  965. var
  966. v : tconstexprint;
  967. t : tnode;
  968. def : tdef;
  969. begin
  970. result:=nil;
  971. { Try optmimizing ourself away }
  972. if left.nodetype=notn then
  973. begin
  974. { Double not. Remove both }
  975. result:=Tnotnode(left).left;
  976. tnotnode(left).left:=nil;
  977. exit;
  978. end;
  979. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  980. begin
  981. { Not of boolean expression. Turn around the operator and remove
  982. the not. This is not allowed for sets with the gten/lten,
  983. because there is no ltn/gtn support }
  984. if (taddnode(left).left.resultdef.typ<>setdef) or
  985. (left.nodetype in [equaln,unequaln]) then
  986. begin
  987. result:=left;
  988. left.nodetype:=boolean_reverse[left.nodetype];
  989. left:=nil;
  990. exit;
  991. end;
  992. end;
  993. { constant folding }
  994. if (left.nodetype=ordconstn) then
  995. begin
  996. v:=tordconstnode(left).value;
  997. def:=left.resultdef;
  998. case torddef(left.resultdef).ordtype of
  999. pasbool8,
  1000. pasbool16,
  1001. pasbool32,
  1002. pasbool64:
  1003. v:=byte(not(boolean(int64(v))));
  1004. bool8bit,
  1005. bool16bit,
  1006. bool32bit,
  1007. bool64bit:
  1008. begin
  1009. if v=0 then
  1010. v:=-1
  1011. else
  1012. v:=0;
  1013. end;
  1014. uchar,
  1015. uwidechar,
  1016. u8bit,
  1017. s8bit,
  1018. u16bit,
  1019. s16bit,
  1020. s32bit,
  1021. u32bit,
  1022. s64bit,
  1023. u64bit:
  1024. begin
  1025. { unsigned, equal or bigger than the native int size? }
  1026. if (torddef(left.resultdef).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
  1027. (is_nativeord(left.resultdef) or is_oversizedord(left.resultdef)) then
  1028. begin
  1029. { Delphi-compatible: not dword = dword (not word = longint) }
  1030. { Extension: not qword = qword }
  1031. v:=qword(not qword(v));
  1032. { will be truncated by the ordconstnode for u32bit }
  1033. end
  1034. else
  1035. begin
  1036. v:=int64(not int64(v));
  1037. def:=get_common_intdef(torddef(left.resultdef),torddef(sinttype),false);
  1038. end;
  1039. end;
  1040. else
  1041. CGMessage(type_e_mismatch);
  1042. end;
  1043. { not-nodes are not range checked by the code generator -> also
  1044. don't range check while inlining; the resultdef is a bit tricky
  1045. though: the node's resultdef gets changed in most cases compared
  1046. to left, but the not-operation itself is caried out in the code
  1047. generator using the size of left
  1048. }
  1049. if not(forinline) then
  1050. t:=cordconstnode.create(v,def,false)
  1051. else
  1052. begin
  1053. { cut off the value if necessary }
  1054. t:=cordconstnode.create(v,left.resultdef,false);
  1055. { now convert to node's resultdef }
  1056. inserttypeconv_explicit(t,def);
  1057. end;
  1058. result:=t;
  1059. exit;
  1060. end;
  1061. end;
  1062. function tnotnode.pass_typecheck : tnode;
  1063. var
  1064. t : tnode;
  1065. begin
  1066. result:=nil;
  1067. typecheckpass(left);
  1068. { avoid any problems with type parameters later on }
  1069. if is_typeparam(left.resultdef) then
  1070. begin
  1071. resultdef:=cundefinedtype;
  1072. exit;
  1073. end;
  1074. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1075. if codegenerror then
  1076. exit;
  1077. { tp procvar support }
  1078. maybe_call_procvar(left,true);
  1079. resultdef:=left.resultdef;
  1080. result:=simplify(false);
  1081. if assigned(result) then
  1082. exit;
  1083. if is_boolean(resultdef) then
  1084. begin
  1085. end
  1086. else
  1087. {$ifdef SUPPORT_MMX}
  1088. if (cs_mmx in current_settings.localswitches) and
  1089. is_mmx_able_array(left.resultdef) then
  1090. begin
  1091. end
  1092. else
  1093. {$endif SUPPORT_MMX}
  1094. {$ifndef cpu64bitaddr}
  1095. if is_64bitint(left.resultdef) then
  1096. begin
  1097. end
  1098. else
  1099. {$endif not cpu64bitaddr}
  1100. if is_integer(left.resultdef) then
  1101. begin
  1102. end
  1103. else
  1104. begin
  1105. { allow operator overloading }
  1106. t:=self;
  1107. if isunaryoverloaded(t) then
  1108. begin
  1109. result:=t;
  1110. exit;
  1111. end;
  1112. CGMessage(type_e_mismatch);
  1113. end;
  1114. end;
  1115. function tnotnode.pass_1 : tnode;
  1116. begin
  1117. result:=nil;
  1118. firstpass(left);
  1119. if codegenerror then
  1120. exit;
  1121. expectloc:=left.expectloc;
  1122. if is_boolean(resultdef) then
  1123. begin
  1124. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1125. expectloc:=LOC_REGISTER;
  1126. { before loading it into flags we need to load it into
  1127. a register thus 1 register is need PM }
  1128. {$ifdef cpuflags}
  1129. if left.expectloc<>LOC_JUMP then
  1130. expectloc:=LOC_FLAGS;
  1131. {$endif def cpuflags}
  1132. end
  1133. else
  1134. {$ifdef SUPPORT_MMX}
  1135. if (cs_mmx in current_settings.localswitches) and
  1136. is_mmx_able_array(left.resultdef) then
  1137. expectloc:=LOC_MMXREGISTER
  1138. else
  1139. {$endif SUPPORT_MMX}
  1140. {$ifndef cpu64bitalu}
  1141. if is_64bit(left.resultdef) then
  1142. begin
  1143. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1144. expectloc:=LOC_REGISTER;
  1145. end
  1146. else
  1147. {$endif not cpu64bitalu}
  1148. if is_integer(left.resultdef) then
  1149. expectloc:=LOC_REGISTER;
  1150. end;
  1151. {$ifdef state_tracking}
  1152. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  1153. begin
  1154. track_state_pass:=true;
  1155. if left.track_state_pass(exec_known) then
  1156. begin
  1157. left.resultdef:=nil;
  1158. do_typecheckpass(left);
  1159. end;
  1160. end;
  1161. {$endif}
  1162. end.