nmat.pas 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293
  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. fdef : tdef;
  840. begin
  841. result:=nil;
  842. firstpass(left);
  843. if codegenerror then
  844. exit;
  845. if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then
  846. begin
  847. if not(target_info.system in systems_wince) then
  848. begin
  849. expectloc:=LOC_REGISTER;
  850. exit;
  851. end
  852. else
  853. begin
  854. case tfloatdef(resultdef).floattype of
  855. s32real:
  856. procname:='negs';
  857. s64real:
  858. procname:='negd';
  859. {!!! not yet implemented
  860. s128real:
  861. }
  862. else
  863. internalerror(2005082802);
  864. end;
  865. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  866. end;
  867. left:=nil;
  868. end
  869. else
  870. begin
  871. if (left.resultdef.typ=floatdef) then
  872. expectloc:=LOC_FPUREGISTER
  873. {$ifdef SUPPORT_MMX}
  874. else if (cs_mmx in current_settings.localswitches) and
  875. is_mmx_able_array(left.resultdef) then
  876. expectloc:=LOC_MMXREGISTER
  877. {$endif SUPPORT_MMX}
  878. else if (left.resultdef.typ=orddef) then
  879. expectloc:=LOC_REGISTER;
  880. end;
  881. end;
  882. {****************************************************************************
  883. TUNARYPLUSNODE
  884. ****************************************************************************}
  885. constructor tunaryplusnode.create(expr: tnode);
  886. begin
  887. inherited create(unaryplusn,expr);
  888. end;
  889. function tunaryplusnode.pass_1: tnode;
  890. begin
  891. result:=nil;
  892. { can never happen because all the conversions happen
  893. in pass_typecheck }
  894. internalerror(201012250);
  895. end;
  896. function tunaryplusnode.pass_typecheck: tnode;
  897. var
  898. t:tnode;
  899. begin
  900. result:=nil;
  901. typecheckpass(left);
  902. { avoid any problems with type parameters later on }
  903. if is_typeparam(left.resultdef) then
  904. begin
  905. resultdef:=cundefinedtype;
  906. exit;
  907. end;
  908. set_varstate(left,vs_read,[vsf_must_be_valid]);
  909. if codegenerror then
  910. exit;
  911. if is_constintnode(left) or
  912. is_constrealnode(left) or
  913. (left.resultdef.typ=floatdef) or
  914. is_currency(left.resultdef)
  915. {$ifdef SUPPORT_MMX}
  916. or ((cs_mmx in current_settings.localswitches) and
  917. is_mmx_able_array(left.resultdef))
  918. {$endif SUPPORT_MMX}
  919. then
  920. begin
  921. result:=left;
  922. left:=nil;
  923. end
  924. else if is_oversizedord(left.resultdef) then
  925. begin
  926. if is_64bit(left.resultdef) then
  927. inserttypeconv(left,s64inttype)
  928. else if is_32bit(left.resultdef) then
  929. inserttypeconv(left,s32inttype)
  930. else if is_16bit(left.resultdef) then
  931. inserttypeconv(left,s16inttype)
  932. else
  933. internalerror(2013040702);
  934. result:=left;
  935. left:=nil;
  936. end
  937. else if (left.resultdef.typ=orddef) then
  938. begin
  939. inserttypeconv(left,sinttype);
  940. result:=left;
  941. left:=nil;
  942. end
  943. else
  944. begin
  945. { allow operator overloading }
  946. t:=self;
  947. if isunaryoverloaded(t) then
  948. begin
  949. result:=t;
  950. exit;
  951. end;
  952. CGMessage(type_e_mismatch);
  953. end;
  954. end;
  955. {****************************************************************************
  956. TNOTNODE
  957. ****************************************************************************}
  958. const
  959. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  960. gten,gtn,lten,ltn,unequaln,equaln
  961. );
  962. constructor tnotnode.create(expr : tnode);
  963. begin
  964. inherited create(notn,expr);
  965. end;
  966. function tnotnode.simplify(forinline : boolean):tnode;
  967. var
  968. v : tconstexprint;
  969. t : tnode;
  970. def : tdef;
  971. begin
  972. result:=nil;
  973. { Try optmimizing ourself away }
  974. if left.nodetype=notn then
  975. begin
  976. { Double not. Remove both }
  977. result:=Tnotnode(left).left;
  978. tnotnode(left).left:=nil;
  979. exit;
  980. end;
  981. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  982. begin
  983. { Not of boolean expression. Turn around the operator and remove
  984. the not. This is not allowed for sets with the gten/lten,
  985. because there is no ltn/gtn support }
  986. if (taddnode(left).left.resultdef.typ<>setdef) or
  987. (left.nodetype in [equaln,unequaln]) then
  988. begin
  989. result:=left;
  990. left.nodetype:=boolean_reverse[left.nodetype];
  991. left:=nil;
  992. exit;
  993. end;
  994. end;
  995. { constant folding }
  996. if (left.nodetype=ordconstn) then
  997. begin
  998. v:=tordconstnode(left).value;
  999. def:=left.resultdef;
  1000. case torddef(left.resultdef).ordtype of
  1001. pasbool8,
  1002. pasbool16,
  1003. pasbool32,
  1004. pasbool64:
  1005. v:=byte(not(boolean(int64(v))));
  1006. bool8bit,
  1007. bool16bit,
  1008. bool32bit,
  1009. bool64bit:
  1010. begin
  1011. if v=0 then
  1012. v:=-1
  1013. else
  1014. v:=0;
  1015. end;
  1016. uchar,
  1017. uwidechar,
  1018. u8bit,
  1019. s8bit,
  1020. u16bit,
  1021. s16bit,
  1022. s32bit,
  1023. u32bit,
  1024. s64bit,
  1025. u64bit:
  1026. begin
  1027. { unsigned, equal or bigger than the native int size? }
  1028. if (torddef(left.resultdef).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
  1029. (is_nativeord(left.resultdef) or is_oversizedord(left.resultdef)) then
  1030. begin
  1031. { Delphi-compatible: not dword = dword (not word = longint) }
  1032. { Extension: not qword = qword }
  1033. v:=qword(not qword(v));
  1034. { will be truncated by the ordconstnode for u32bit }
  1035. end
  1036. else
  1037. begin
  1038. v:=int64(not int64(v));
  1039. def:=get_common_intdef(torddef(left.resultdef),torddef(sinttype),false);
  1040. end;
  1041. end;
  1042. else
  1043. CGMessage(type_e_mismatch);
  1044. end;
  1045. { not-nodes are not range checked by the code generator -> also
  1046. don't range check while inlining; the resultdef is a bit tricky
  1047. though: the node's resultdef gets changed in most cases compared
  1048. to left, but the not-operation itself is caried out in the code
  1049. generator using the size of left
  1050. }
  1051. if not(forinline) then
  1052. t:=cordconstnode.create(v,def,false)
  1053. else
  1054. begin
  1055. { cut off the value if necessary }
  1056. t:=cordconstnode.create(v,left.resultdef,false);
  1057. { now convert to node's resultdef }
  1058. inserttypeconv_explicit(t,def);
  1059. end;
  1060. result:=t;
  1061. exit;
  1062. end;
  1063. end;
  1064. function tnotnode.pass_typecheck : tnode;
  1065. var
  1066. t : tnode;
  1067. begin
  1068. result:=nil;
  1069. typecheckpass(left);
  1070. { avoid any problems with type parameters later on }
  1071. if is_typeparam(left.resultdef) then
  1072. begin
  1073. resultdef:=cundefinedtype;
  1074. exit;
  1075. end;
  1076. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1077. if codegenerror then
  1078. exit;
  1079. { tp procvar support }
  1080. maybe_call_procvar(left,true);
  1081. resultdef:=left.resultdef;
  1082. result:=simplify(false);
  1083. if assigned(result) then
  1084. exit;
  1085. if is_boolean(resultdef) then
  1086. begin
  1087. end
  1088. else
  1089. {$ifdef SUPPORT_MMX}
  1090. if (cs_mmx in current_settings.localswitches) and
  1091. is_mmx_able_array(left.resultdef) then
  1092. begin
  1093. end
  1094. else
  1095. {$endif SUPPORT_MMX}
  1096. {$ifndef cpu64bitaddr}
  1097. if is_64bitint(left.resultdef) then
  1098. begin
  1099. end
  1100. else
  1101. {$endif not cpu64bitaddr}
  1102. if is_integer(left.resultdef) then
  1103. begin
  1104. end
  1105. else
  1106. begin
  1107. { allow operator overloading }
  1108. t:=self;
  1109. if isunaryoverloaded(t) then
  1110. begin
  1111. result:=t;
  1112. exit;
  1113. end;
  1114. CGMessage(type_e_mismatch);
  1115. end;
  1116. end;
  1117. function tnotnode.pass_1 : tnode;
  1118. begin
  1119. result:=nil;
  1120. firstpass(left);
  1121. if codegenerror then
  1122. exit;
  1123. expectloc:=left.expectloc;
  1124. if is_boolean(resultdef) then
  1125. begin
  1126. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1127. expectloc:=LOC_REGISTER;
  1128. { before loading it into flags we need to load it into
  1129. a register thus 1 register is need PM }
  1130. {$ifdef cpuflags}
  1131. if left.expectloc<>LOC_JUMP then
  1132. expectloc:=LOC_FLAGS;
  1133. {$endif def cpuflags}
  1134. end
  1135. else
  1136. {$ifdef SUPPORT_MMX}
  1137. if (cs_mmx in current_settings.localswitches) and
  1138. is_mmx_able_array(left.resultdef) then
  1139. expectloc:=LOC_MMXREGISTER
  1140. else
  1141. {$endif SUPPORT_MMX}
  1142. {$ifndef cpu64bitalu}
  1143. if is_64bit(left.resultdef) then
  1144. begin
  1145. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1146. expectloc:=LOC_REGISTER;
  1147. end
  1148. else
  1149. {$endif not cpu64bitalu}
  1150. if is_integer(left.resultdef) then
  1151. expectloc:=LOC_REGISTER;
  1152. end;
  1153. {$ifdef state_tracking}
  1154. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  1155. begin
  1156. track_state_pass:=true;
  1157. if left.track_state_pass(exec_known) then
  1158. begin
  1159. left.resultdef:=nil;
  1160. do_typecheckpass(left);
  1161. end;
  1162. end;
  1163. {$endif}
  1164. end.