optcse.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518
  1. {
  2. Common subexpression elimination on base blocks
  3. Copyright (c) 2005-2012 by Florian Klaempfl
  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 optcse;
  18. {$i fpcdefs.inc}
  19. { $define csedebug}
  20. { $define csestats}
  21. interface
  22. uses
  23. node;
  24. {
  25. the function creates non optimal code so far:
  26. - call para nodes are cse barriers because they can be reordered and thus the
  27. temp. creation could be done too late
  28. - the cse knows nothing about register pressure. In case of high register pressure, cse might
  29. have a negative impact
  30. - the list of cseinvariant node types and inline numbers is not complete yet
  31. Further, it could be done probably in a faster way though the complexity can't probably not reduced
  32. }
  33. function do_optcse(var rootnode : tnode) : tnode;
  34. implementation
  35. uses
  36. globtype,globals,
  37. cutils,cclasses,
  38. nutils,
  39. nbas,nld,ninl,ncal,nadd,nmem,
  40. pass_1,
  41. symconst,symdef,symsym,
  42. defutil,
  43. optbase;
  44. const
  45. cseinvariant : set of tnodetype = [addn,muln,subn,divn,slashn,modn,andn,orn,xorn,notn,vecn,
  46. derefn,equaln,unequaln,ltn,gtn,lten,gten,typeconvn,subscriptn,
  47. inn,symdifn,shrn,shln,ordconstn,realconstn,unaryminusn,pointerconstn,stringconstn,setconstn,niln,
  48. setelementn,{arrayconstructorn,arrayconstructorrangen,}
  49. isn,asn,starstarn,nothingn,temprefn,loadparentfpn {,callparan},assignn,addrn];
  50. function searchsubdomain(var n:tnode; arg: pointer) : foreachnoderesult;
  51. begin
  52. if (n.nodetype in cseinvariant) or
  53. ((n.nodetype=inlinen) and
  54. (tinlinenode(n).inlinenumber in [in_assigned_x,in_sqr_real,in_sqrt_real,in_sin_real,in_cos_real,in_abs_long,
  55. in_abs_real,in_exp_real,in_ln_real,in_pi_real,in_popcnt_x,in_arctan_real,in_round_real,in_trunc_real,
  56. { cse on fma will still not work because it would require proper handling of call nodes
  57. with more than one parameter }
  58. in_fma_single,in_fma_double,in_fma_extended,in_fma_float128])
  59. ) or
  60. ((n.nodetype=callparan) and not(assigned(tcallparanode(n).right))) or
  61. ((n.nodetype=loadn) and
  62. not((tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) and
  63. (vo_volatile in tabstractvarsym(tloadnode(n).symtableentry).varoptions))
  64. ) then
  65. result:=fen_true
  66. else
  67. begin
  68. pboolean(arg)^:=false;
  69. result:=fen_norecurse_true;
  70. end;
  71. end;
  72. type
  73. tlists = record
  74. nodelist : tfplist;
  75. locationlist : tfplist;
  76. equalto : tfplist;
  77. refs : tfplist;
  78. avail : TDFASet;
  79. end;
  80. plists = ^tlists;
  81. { collectnodes needs the address of itself to call foreachnodestatic,
  82. so we need a wrapper because @<func> inside <func doesn't work }
  83. function collectnodes(var n:tnode; arg: pointer) : foreachnoderesult;forward;
  84. function collectnodes2(var n:tnode; arg: pointer) : foreachnoderesult;
  85. begin
  86. result:=collectnodes(n,arg);
  87. end;
  88. function collectnodes(var n:tnode; arg: pointer) : foreachnoderesult;
  89. { when compiling a tree like
  90. and
  91. / \
  92. and C
  93. / \
  94. A B
  95. all expressions of B are available during evaluation of C. However considerung the whole expression,
  96. values of B and C might not be available due to short boolean evaluation.
  97. So recurseintobooleanchain detectes such chained and/or expressions and makes sub-expressions of B
  98. available during the evaluation of C
  99. firstleftend is later used to remove all sub expressions of B and C by storing the expression count
  100. in the cse table after handling A
  101. }
  102. var
  103. firstleftend : longint;
  104. procedure recurseintobooleanchain(t : tnodetype;n : tnode);
  105. begin
  106. if (tbinarynode(n).left.nodetype=t) and is_boolean(tbinarynode(n).left.resultdef) then
  107. recurseintobooleanchain(t,tbinarynode(n).left)
  108. else
  109. foreachnodestatic(pm_postprocess,tbinarynode(n).left,@collectnodes2,arg);
  110. firstleftend:=min(plists(arg)^.nodelist.count,firstleftend);
  111. foreachnodestatic(pm_postprocess,tbinarynode(n).right,@collectnodes2,arg);
  112. end;
  113. var
  114. i : longint;
  115. begin
  116. result:=fen_false;
  117. { don't add the tree below an untyped const parameter: there is
  118. no information available that this kind of tree actually needs
  119. to be addresable, this could be improved }
  120. { the nodes below a type conversion node created for an absolute
  121. reference cannot be handled separately, because the absolute reference
  122. may have special requirements (no regability, must be in memory, ...)
  123. }
  124. if (((n.nodetype=callparan) and
  125. (tcallparanode(n).left.resultdef.typ=formaldef) and
  126. (tcallparanode(n).parasym.varspez=vs_const)) or
  127. ((n.nodetype=typeconvn) and
  128. (nf_absolute in n.flags))
  129. ) then
  130. begin
  131. result:=fen_norecurse_false;
  132. exit;
  133. end;
  134. if
  135. { node possible to add? }
  136. assigned(n.resultdef) and
  137. (
  138. { regable expressions }
  139. (actualtargetnode(@n)^.flags*[nf_write,nf_modify,nf_address_taken]=[]) and
  140. ((((tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable or tstoreddef(n.resultdef).is_const_intregable) and
  141. { is_int/fpuregable allows arrays and records to be in registers, cse cannot handle this }
  142. (not(n.resultdef.typ in [arraydef,recorddef]))) or is_dynamic_array(n.resultdef)) and
  143. { same for voiddef }
  144. not(is_void(n.resultdef)) and
  145. { adding tempref and callpara nodes itself is worthless but
  146. their complexity is probably <= 1 anyways
  147. neither add setelementn nodes because the compiler sometimes depends on the fact
  148. that a certain node stays a setelementn, this does not hurt either because
  149. setelementn nodes itself generate no real code (except moving data into register) }
  150. not(n.nodetype in [temprefn,callparan,setelementn]) and
  151. { node worth to add?
  152. We consider almost every node because even loading a variables from
  153. a register instead of memory is more beneficial. This behaviour should
  154. not increase register pressure because if a variable is already
  155. in a register, the reg. allocator can merge the nodes. If a variable
  156. is loaded from memory, loading this variable and spilling another register
  157. should not add a speed penalty.
  158. }
  159. {
  160. load nodes are not considered if they load para or local symbols from the
  161. current stack frame, those are in registers anyways if possible
  162. }
  163. (not(actualtargetnode(@n)^.nodetype=loadn) or
  164. not(tloadnode(actualtargetnode(@n)^).symtableentry.typ in [paravarsym,localvarsym,staticvarsym]) or
  165. { apply cse on non-regable variables }
  166. ((tloadnode(actualtargetnode(@n)^).symtableentry.typ in [paravarsym,localvarsym,staticvarsym]) and
  167. not(tabstractvarsym(tloadnode(actualtargetnode(@n)^).symtableentry).is_regvar(false)) and
  168. not(vo_volatile in tabstractvarsym(tloadnode(actualtargetnode(@n)^).symtableentry).varoptions)) or
  169. (node_complexity(n)>1)
  170. ) and
  171. {
  172. Const nodes however are only considered if their complexity is >1
  173. This might be the case for the risc architectures if they need
  174. more than one instruction to load this particular value
  175. }
  176. (not(is_constnode(n)) or (node_complexity(n)>1)))
  177. {$if not(defined(i386)) and not(defined(i8086))}
  178. or
  179. { store reference of expression? }
  180. { loading the address of a global symbol takes typically more than
  181. one instruction on every platform except i8086/i386
  182. so consider in this case loading the address of the data
  183. }
  184. (((n.resultdef.typ in [arraydef,recorddef]) or is_object(n.resultdef)) and not(is_dynamic_array(n.resultdef)) and
  185. (n.nodetype=loadn) and
  186. (tloadnode(n).symtableentry.typ=staticvarsym)
  187. )
  188. {$endif not(defined(i386)) and not(defined(i8086))}
  189. ) then
  190. begin
  191. plists(arg)^.nodelist.Add(n);
  192. plists(arg)^.locationlist.Add(@n);
  193. plists(arg)^.refs.Add(nil);
  194. plists(arg)^.equalto.Add(pointer(-1));
  195. DFASetInclude(plists(arg)^.avail,plists(arg)^.nodelist.count-1);
  196. for i:=0 to plists(arg)^.nodelist.count-2 do
  197. begin
  198. if tnode(plists(arg)^.nodelist[i]).isequal(n) and DFASetIn(plists(arg)^.avail,i) then
  199. begin
  200. { use always the first occurence }
  201. if plists(arg)^.equalto[i]<>pointer(-1) then
  202. plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=plists(arg)^.equalto[i]
  203. else
  204. plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=pointer(ptrint(i));
  205. plists(arg)^.refs[i]:=pointer(plists(arg)^.refs[i])+1;
  206. { tree has been found, no need to search further,
  207. sub-trees have been added by the first occurence of
  208. the tree already }
  209. result:=fen_norecurse_false;
  210. break;
  211. end;
  212. end;
  213. end;
  214. { boolean and/or require a special handling: after evaluating the and/or node,
  215. the expressions of the right side might not be available due to short boolean
  216. evaluation, so after handling the right side, mark those expressions
  217. as unavailable }
  218. if (n.nodetype in [orn,andn]) and is_boolean(taddnode(n).left.resultdef) then
  219. begin
  220. firstleftend:=high(longint);
  221. recurseintobooleanchain(n.nodetype,n);
  222. for i:=firstleftend to plists(arg)^.nodelist.count-1 do
  223. DFASetExclude(plists(arg)^.avail,i);
  224. result:=fen_norecurse_false;
  225. end;
  226. {$ifdef cpuhighleveltarget}
  227. { The high level targets use the functionality from ncgnstld for
  228. nested accesses, and that one stores the complete location of the
  229. nested variable in tloadnode.left rather than only the location of
  230. the parent context containing it. This causes problems with the
  231. CSE in case the nested variable is used as an lvalue, so disable
  232. CSE in that case
  233. }
  234. if (n.nodetype=loadn) and assigned(tloadnode(n).left) then
  235. result:=fen_norecurse_false;
  236. {$endif}
  237. end;
  238. function searchcsedomain(var n: tnode; arg: pointer) : foreachnoderesult;
  239. var
  240. csedomain : boolean;
  241. lists : tlists;
  242. templist : tfplist;
  243. i : longint;
  244. def : tstoreddef;
  245. nodes : tblocknode;
  246. creates,
  247. statements : tstatementnode;
  248. hp : ttempcreatenode;
  249. addrstored : boolean;
  250. hp2 : tnode;
  251. begin
  252. result:=fen_false;
  253. nodes:=nil;
  254. if n.nodetype in cseinvariant then
  255. begin
  256. csedomain:=true;
  257. foreachnodestatic(pm_postprocess,n,@searchsubdomain,@csedomain);
  258. if not(csedomain) then
  259. begin
  260. { try to transform the tree to get better cse domains, consider:
  261. +
  262. / \
  263. + C
  264. / \
  265. A B
  266. if A is not cse'able but B and C are, then the compiler cannot do cse so the tree is transformed into
  267. +
  268. / \
  269. A +
  270. / \
  271. B C
  272. Because A could be another tree of this kind, the whole process is done in a while loop
  273. }
  274. if (n.nodetype in [andn,orn,addn,muln]) and
  275. (n.nodetype=tbinarynode(n).left.nodetype) and
  276. { do is optimizations only for integers, reals (no currency!), vectors, sets or booleans }
  277. (is_integer(n.resultdef) or is_real(n.resultdef) or is_vector(n.resultdef) or is_set(n.resultdef) or
  278. is_boolean(n.resultdef)) and
  279. { either if fastmath is on }
  280. ((cs_opt_fastmath in current_settings.optimizerswitches) or
  281. { or for the logical operators, they cannot overflow }
  282. (n.nodetype in [andn,orn]) or
  283. { or for integers if range checking is off }
  284. ((is_integer(n.resultdef) and
  285. (n.localswitches*[cs_check_range,cs_check_overflow]=[]) and
  286. (tbinarynode(n).left.localswitches*[cs_check_range,cs_check_overflow]=[]))) or
  287. { for sets, we can do this always }
  288. (is_set(n.resultdef))
  289. ) then
  290. while (n.nodetype=tbinarynode(n).left.nodetype) and
  291. { the resulttypes of the operands we'll swap must be equal,
  292. required in case of a 32x32->64 multiplication, then we
  293. cannot swap out one of the 32 bit operands for a 64 bit one
  294. }
  295. (tbinarynode(tbinarynode(n).left).left.resultdef=tbinarynode(n).left.resultdef) and
  296. (tbinarynode(n).left.resultdef=tbinarynode(n).right.resultdef) do
  297. begin
  298. csedomain:=true;
  299. foreachnodestatic(pm_postprocess,tbinarynode(n).right,@searchsubdomain,@csedomain);
  300. if csedomain then
  301. begin
  302. csedomain:=true;
  303. foreachnodestatic(pm_postprocess,tbinarynode(tbinarynode(n).left).right,@searchsubdomain,@csedomain);
  304. if csedomain then
  305. begin
  306. hp2:=tbinarynode(tbinarynode(n).left).left;
  307. tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
  308. tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;
  309. tbinarynode(n).right:=tbinarynode(n).left;
  310. tbinarynode(n).left:=hp2;
  311. { the transformed tree could result in new possibilities to fold constants
  312. so force a firstpass on the root node }
  313. exclude(tbinarynode(n).right.flags,nf_pass1_done);
  314. do_firstpass(tbinarynode(n).right);
  315. end
  316. else
  317. break;
  318. end
  319. else
  320. break;
  321. end;
  322. end
  323. else
  324. begin
  325. statements:=nil;
  326. result:=fen_norecurse_true;
  327. {$ifdef csedebug}
  328. writeln('============ cse domain ==================');
  329. printnode(output,n);
  330. writeln('Complexity: ',node_complexity(n));
  331. {$endif csedebug}
  332. lists.nodelist:=tfplist.create;
  333. lists.locationlist:=tfplist.create;
  334. lists.equalto:=tfplist.create;
  335. lists.refs:=tfplist.create;
  336. foreachnodestatic(pm_postprocess,n,@collectnodes,@lists);
  337. templist:=tfplist.create;
  338. templist.count:=lists.nodelist.count;
  339. { check all nodes if one is used more than once }
  340. for i:=0 to lists.nodelist.count-1 do
  341. begin
  342. { current node used more than once? }
  343. if assigned(lists.refs[i]) then
  344. begin
  345. if not(assigned(statements)) then
  346. begin
  347. nodes:=internalstatements(statements);
  348. addstatement(statements,internalstatements(creates));
  349. end;
  350. def:=tstoreddef(tnode(lists.nodelist[i]).resultdef);
  351. { we cannot handle register stored records or array in CSE yet
  352. but we can store their reference }
  353. addrstored:=((def.typ in [arraydef,recorddef]) or is_object(def)) and not(is_dynamic_array(def));
  354. if addrstored then
  355. templist[i]:=ctempcreatenode.create_value(getpointerdef(def),voidpointertype.size,tt_persistent,
  356. true,caddrnode.create_internal(tnode(lists.nodelist[i])))
  357. else
  358. templist[i]:=ctempcreatenode.create_value(def,def.size,tt_persistent,
  359. def.is_intregable or def.is_fpuregable or def.is_const_intregable,tnode(lists.nodelist[i]));
  360. { the value described by the temp. is immutable and the temp. can be always in register
  361. ttempcreatenode.create normally takes care of the register location but it does not
  362. know about immutability so it cannot take care of managed types }
  363. include(ttempcreatenode(templist[i]).tempinfo^.flags,ti_const);
  364. include(ttempcreatenode(templist[i]).tempinfo^.flags,ti_may_be_in_reg);
  365. { make debugging easier and set temp. location to the original location }
  366. tnode(templist[i]).fileinfo:=tnode(lists.nodelist[i]).fileinfo;
  367. addstatement(creates,tnode(templist[i]));
  368. { make debugging easier and set temp. location to the original location }
  369. creates.fileinfo:=tnode(lists.nodelist[i]).fileinfo;
  370. hp:=ttempcreatenode(templist[i]);
  371. do_firstpass(tnode(hp));
  372. templist[i]:=hp;
  373. if addrstored then
  374. pnode(lists.locationlist[i])^:=cderefnode.Create(ctemprefnode.create(ttempcreatenode(templist[i])))
  375. else
  376. pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i]));
  377. { make debugging easier and set temp. location to the original location }
  378. pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo;
  379. do_firstpass(pnode(lists.locationlist[i])^);
  380. {$ifdef csedebug}
  381. printnode(output,statements);
  382. {$endif csedebug}
  383. end
  384. { current node reference to another node? }
  385. else if lists.equalto[i]<>pointer(-1) then
  386. begin
  387. def:=tstoreddef(tnode(lists.nodelist[i]).resultdef);
  388. { we cannot handle register stored records or array in CSE yet
  389. but we can store their reference }
  390. addrstored:=((def.typ in [arraydef,recorddef]) or is_object(def)) and not(is_dynamic_array(def));
  391. {$if defined(csedebug) or defined(csestats)}
  392. writeln;
  393. writeln('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
  394. writeln('Complexity: ',node_complexity(tnode(lists.nodelist[i])),' Node ',i,' equals Node ',ptrint(lists.equalto[i]));
  395. printnode(output,tnode(lists.nodelist[i]));
  396. printnode(output,tnode(lists.nodelist[ptrint(lists.equalto[i])]));
  397. writeln('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
  398. writeln;
  399. {$endif defined(csedebug) or defined(csestats)}
  400. templist[i]:=templist[ptrint(lists.equalto[i])];
  401. if addrstored then
  402. pnode(lists.locationlist[i])^:=cderefnode.Create(ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])])))
  403. else
  404. pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])]));
  405. { make debugging easier and set temp. location to the original location }
  406. pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo;
  407. do_firstpass(pnode(lists.locationlist[i])^);
  408. end;
  409. end;
  410. { clean up unused trees }
  411. for i:=0 to lists.nodelist.count-1 do
  412. if lists.equalto[i]<>pointer(-1) then
  413. tnode(lists.nodelist[i]).free;
  414. {$ifdef csedebug}
  415. writeln('nodes: ',lists.nodelist.count);
  416. writeln('==========================================');
  417. {$endif csedebug}
  418. lists.nodelist.free;
  419. lists.locationlist.free;
  420. lists.equalto.free;
  421. lists.refs.free;
  422. templist.free;
  423. if assigned(statements) then
  424. begin
  425. { call para nodes need a special handling because
  426. they can be only children nodes of call nodes
  427. so the initialization code is inserted below the
  428. call para node
  429. }
  430. if n.nodetype=callparan then
  431. begin
  432. addstatement(statements,tcallparanode(n).left);
  433. tcallparanode(n).left:=nodes;
  434. do_firstpass(tcallparanode(n).left);
  435. end
  436. else
  437. begin
  438. addstatement(statements,n);
  439. n:=nodes;
  440. do_firstpass(n);
  441. end;
  442. {$ifdef csedebug}
  443. printnode(output,nodes);
  444. {$endif csedebug}
  445. end;
  446. end
  447. end;
  448. end;
  449. function do_optcse(var rootnode : tnode) : tnode;
  450. begin
  451. {$ifdef csedebug}
  452. writeln('====================================================================================');
  453. writeln('CSE optimization pass started');
  454. writeln('====================================================================================');
  455. printnode(rootnode);
  456. writeln('====================================================================================');
  457. writeln;
  458. {$endif csedebug}
  459. foreachnodestatic(pm_postprocess,rootnode,@searchcsedomain,nil);
  460. result:=nil;
  461. end;
  462. end.