nutils.pas 40 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Type checking and register allocation for inline 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 nutils;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,constexp,
  22. symtype,symsym,symbase,symtable,
  23. node;
  24. const
  25. NODE_COMPLEXITY_INF = 255;
  26. type
  27. { resultdef of functions that process on all nodes in a (sub)tree }
  28. foreachnoderesult = (
  29. { false, continue recursion }
  30. fen_false,
  31. { false, stop recursion }
  32. fen_norecurse_false,
  33. { true, continue recursion }
  34. fen_true,
  35. { true, stop recursion }
  36. fen_norecurse_true
  37. );
  38. tforeachprocmethod = (pm_preprocess,pm_postprocess,
  39. pm_postandagain);
  40. foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
  41. staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
  42. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  43. function foreachnode(procmethod : tforeachprocmethod; var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  44. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  45. function foreachnodestatic(procmethod : tforeachprocmethod; var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  46. { checks if the given node tree contains only nodes of the given type,
  47. if this isn't the case, an ie is thrown
  48. }
  49. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  50. procedure load_procvar_from_calln(var p1:tnode);
  51. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  52. function load_high_value_node(vs:tparavarsym):tnode;
  53. function load_self_node:tnode;
  54. function load_result_node:tnode;
  55. function load_self_pointer_node:tnode;
  56. function load_vmt_pointer_node:tnode;
  57. function is_self_node(p:tnode):boolean;
  58. function node_complexity(p: tnode): cardinal;
  59. function node_resources_fpu(p: tnode): cardinal;
  60. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  61. { tries to simplify the given node after inlining }
  62. procedure doinlinesimplify(var n : tnode);
  63. { creates an ordinal constant, optionally based on the result from a
  64. simplify operation: normally the type is the smallest integer type
  65. that can hold the value, but when inlining the "def" will be used instead,
  66. which was determined during an earlier typecheck pass (because the value
  67. may e.g. be a parameter to a call, which needs to be of the declared
  68. parameter type) }
  69. function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
  70. { returns true if n is only a tree of administrative nodes
  71. containing no code }
  72. function has_no_code(n : tnode) : boolean;
  73. function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
  74. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  75. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  76. { checks whether sym is a static field and if so, translates the access
  77. to the appropriate node tree }
  78. function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean;
  79. { returns true if n is an array element access of a bitpacked array with
  80. elements of the which the vitsize mod 8 <> 0, or if is a field access
  81. with bitsize mod 8 <> 0 or bitoffset mod 8 <> 0 of an element in a
  82. bitpacked structure }
  83. function is_bitpacked_access(n: tnode): boolean;
  84. { creates a load of field 'fieldname' in the record/class/...
  85. represented by n }
  86. function genloadfield(n: tnode; const fieldname: string): tnode;
  87. { returns true, if the tree given might have side effects }
  88. function might_have_sideeffects(n : tnode) : boolean;
  89. { count the number of nodes in the node tree,
  90. rough estimation how large the tree "node" is }
  91. function node_count(node : tnode) : dword;
  92. { trashes the given temp. node }
  93. function trash_tempref(node : tnode) : tnode;
  94. implementation
  95. uses
  96. cutils,verbose,globals,
  97. symconst,symdef,
  98. defutil,defcmp,
  99. nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
  100. cpubase,cgbase,procinfo,
  101. pass_1;
  102. function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  103. function process_children(res : boolean) : boolean;
  104. var
  105. i: longint;
  106. begin
  107. result:=res;
  108. case n.nodetype of
  109. asn:
  110. if assigned(tasnode(n).call) then
  111. begin
  112. result := foreachnode(procmethod,tasnode(n).call,f,arg);
  113. exit
  114. end;
  115. calln:
  116. begin
  117. result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  118. result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  119. result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  120. result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  121. end;
  122. ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
  123. begin
  124. { not in one statement, won't work because of b- }
  125. result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result;
  126. result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result;
  127. end;
  128. raisen:
  129. { frame tree }
  130. result := foreachnode(traisenode(n).third,f,arg) or result;
  131. tempcreaten:
  132. { temp. initialization code }
  133. if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
  134. result := foreachnode(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result;
  135. casen:
  136. begin
  137. for i := 0 to tcasenode(n).blocks.count-1 do
  138. if assigned(tcasenode(n).blocks[i]) then
  139. result := foreachnode(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  140. result := foreachnode(procmethod,tcasenode(n).elseblock,f,arg) or result;
  141. end;
  142. end;
  143. if n.inheritsfrom(tbinarynode) then
  144. begin
  145. { first process the "payload" of statementnodes }
  146. result := foreachnode(procmethod,tbinarynode(n).left,f,arg) or result;
  147. result := foreachnode(procmethod,tbinarynode(n).right,f,arg) or result;
  148. end
  149. else if n.inheritsfrom(tunarynode) then
  150. result := foreachnode(procmethod,tunarynode(n).left,f,arg) or result;
  151. end;
  152. begin
  153. result := false;
  154. if not assigned(n) then
  155. exit;
  156. if procmethod=pm_preprocess then
  157. result:=process_children(result);
  158. case f(n,arg) of
  159. fen_norecurse_false:
  160. exit;
  161. fen_norecurse_true:
  162. begin
  163. result := true;
  164. exit;
  165. end;
  166. fen_true:
  167. result := true;
  168. { result is already false
  169. fen_false:
  170. result := false; }
  171. end;
  172. if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
  173. result:=process_children(result);
  174. if procmethod=pm_postandagain then
  175. begin
  176. case f(n,arg) of
  177. fen_norecurse_false:
  178. exit;
  179. fen_norecurse_true:
  180. begin
  181. result := true;
  182. exit;
  183. end;
  184. fen_true:
  185. result := true;
  186. end;
  187. end;
  188. end;
  189. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  190. begin
  191. result:=foreachnode(pm_postprocess,n,f,arg);
  192. end;
  193. function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  194. function process_children(res : boolean) : boolean;
  195. var
  196. i: longint;
  197. begin
  198. result:=res;
  199. case n.nodetype of
  200. asn:
  201. if assigned(tasnode(n).call) then
  202. begin
  203. result := foreachnodestatic(procmethod,tasnode(n).call,f,arg);
  204. exit
  205. end;
  206. calln:
  207. begin
  208. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  209. result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  210. result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  211. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  212. end;
  213. ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
  214. begin
  215. { not in one statement, won't work because of b- }
  216. result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result;
  217. result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result;
  218. end;
  219. raisen:
  220. { frame tree }
  221. result := foreachnodestatic(traisenode(n).third,f,arg) or result;
  222. tempcreaten:
  223. { temp. initialization code }
  224. if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
  225. result := foreachnodestatic(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result;
  226. casen:
  227. begin
  228. for i := 0 to tcasenode(n).blocks.count-1 do
  229. if assigned(tcasenode(n).blocks[i]) then
  230. result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  231. result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result;
  232. end;
  233. end;
  234. if n.inheritsfrom(tbinarynode) then
  235. begin
  236. { first process the "payload" of statementnodes }
  237. result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result;
  238. result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result;
  239. end
  240. else if n.inheritsfrom(tunarynode) then
  241. result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result;
  242. end;
  243. begin
  244. result := false;
  245. if not assigned(n) then
  246. exit;
  247. if procmethod=pm_preprocess then
  248. result:=process_children(result);
  249. case f(n,arg) of
  250. fen_norecurse_false:
  251. exit;
  252. fen_norecurse_true:
  253. begin
  254. result := true;
  255. exit;
  256. end;
  257. fen_true:
  258. result := true;
  259. { result is already false
  260. fen_false:
  261. result := false; }
  262. end;
  263. if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
  264. result:=process_children(result);
  265. if procmethod=pm_postandagain then
  266. begin
  267. case f(n,arg) of
  268. fen_norecurse_false:
  269. exit;
  270. fen_norecurse_true:
  271. begin
  272. result := true;
  273. exit;
  274. end;
  275. fen_true:
  276. result := true;
  277. end;
  278. end;
  279. end;
  280. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  281. begin
  282. result:=foreachnodestatic(pm_postprocess,n,f,arg);
  283. end;
  284. function do_check(var n: tnode; arg: pointer): foreachnoderesult;
  285. begin
  286. if not(n.nodetype in pnodetypeset(arg)^) then
  287. internalerror(200610141);
  288. result:=fen_true;
  289. end;
  290. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  291. begin
  292. foreachnodestatic(n,@do_check,@typeset);
  293. end;
  294. procedure load_procvar_from_calln(var p1:tnode);
  295. var
  296. p2 : tnode;
  297. begin
  298. if p1.nodetype<>calln then
  299. internalerror(200212251);
  300. { was it a procvar, then we simply remove the calln and
  301. reuse the right }
  302. if assigned(tcallnode(p1).right) then
  303. begin
  304. p2:=tcallnode(p1).right;
  305. tcallnode(p1).right:=nil;
  306. end
  307. else
  308. begin
  309. p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
  310. tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
  311. { when the methodpointer is typen we've something like:
  312. tobject.create. Then only the address is needed of the
  313. method without a self pointer }
  314. if assigned(tcallnode(p1).methodpointer) and
  315. (tcallnode(p1).methodpointer.nodetype<>typen) then
  316. tloadnode(p2).set_mp(tcallnode(p1).methodpointer.getcopy);
  317. end;
  318. typecheckpass(p2);
  319. p1.free;
  320. p1:=p2;
  321. end;
  322. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  323. var
  324. hp : tnode;
  325. begin
  326. result:=false;
  327. if (p1.resultdef.typ<>procvardef) or
  328. (tponly and
  329. not(m_tp_procvar in current_settings.modeswitches)) then
  330. exit;
  331. { ignore vecn,subscriptn }
  332. hp:=p1;
  333. repeat
  334. case hp.nodetype of
  335. vecn,
  336. derefn,
  337. typeconvn,
  338. subscriptn :
  339. hp:=tunarynode(hp).left;
  340. else
  341. break;
  342. end;
  343. until false;
  344. { a tempref is used when it is loaded from a withsymtable }
  345. if (hp.nodetype in [calln,loadn,temprefn]) then
  346. begin
  347. hp:=ccallnode.create_procvar(nil,p1);
  348. typecheckpass(hp);
  349. p1:=hp;
  350. result:=true;
  351. end;
  352. end;
  353. function get_local_or_para_sym(const aname:string):tsym;
  354. var
  355. pd : tprocdef;
  356. begin
  357. result:=nil;
  358. { is not assigned while parsing a property }
  359. if not assigned(current_procinfo) then
  360. exit;
  361. { we can't use searchsym here, because the
  362. symtablestack is not fully setup when pass1
  363. is run for nested procedures }
  364. pd:=current_procinfo.procdef;
  365. repeat
  366. result := tsym(pd.localst.Find(aname));
  367. if assigned(result) then
  368. break;
  369. result := tsym(pd.parast.Find(aname));
  370. if assigned(result) then
  371. break;
  372. { try the parent of a nested function }
  373. if assigned(pd.owner.defowner) and
  374. (pd.owner.defowner.typ=procdef) then
  375. pd:=tprocdef(pd.owner.defowner)
  376. else
  377. break;
  378. until false;
  379. end;
  380. function load_high_value_node(vs:tparavarsym):tnode;
  381. var
  382. srsym : tsym;
  383. begin
  384. result:=nil;
  385. srsym:=get_high_value_sym(vs);
  386. if assigned(srsym) then
  387. begin
  388. result:=cloadnode.create(srsym,vs.owner);
  389. typecheckpass(result);
  390. end
  391. else
  392. CGMessage(parser_e_illegal_expression);
  393. end;
  394. function load_self_node:tnode;
  395. var
  396. srsym : tsym;
  397. begin
  398. result:=nil;
  399. srsym:=get_local_or_para_sym('self');
  400. if assigned(srsym) then
  401. begin
  402. result:=cloadnode.create(srsym,srsym.owner);
  403. include(tloadnode(result).loadnodeflags,loadnf_is_self);
  404. end
  405. else
  406. begin
  407. result:=cerrornode.create;
  408. CGMessage(parser_e_illegal_expression);
  409. end;
  410. typecheckpass(result);
  411. end;
  412. function load_result_node:tnode;
  413. var
  414. srsym : tsym;
  415. begin
  416. result:=nil;
  417. srsym:=get_local_or_para_sym('result');
  418. if assigned(srsym) then
  419. result:=cloadnode.create(srsym,srsym.owner)
  420. else
  421. begin
  422. result:=cerrornode.create;
  423. CGMessage(parser_e_illegal_expression);
  424. end;
  425. typecheckpass(result);
  426. end;
  427. function load_self_pointer_node:tnode;
  428. var
  429. srsym : tsym;
  430. begin
  431. result:=nil;
  432. srsym:=get_local_or_para_sym('self');
  433. if assigned(srsym) then
  434. begin
  435. result:=cloadnode.create(srsym,srsym.owner);
  436. include(tloadnode(result).loadnodeflags,loadnf_load_self_pointer);
  437. end
  438. else
  439. begin
  440. result:=cerrornode.create;
  441. CGMessage(parser_e_illegal_expression);
  442. end;
  443. typecheckpass(result);
  444. end;
  445. function load_vmt_pointer_node:tnode;
  446. var
  447. srsym : tsym;
  448. begin
  449. result:=nil;
  450. srsym:=get_local_or_para_sym('vmt');
  451. if assigned(srsym) then
  452. result:=cloadnode.create(srsym,srsym.owner)
  453. else
  454. begin
  455. result:=cerrornode.create;
  456. CGMessage(parser_e_illegal_expression);
  457. end;
  458. typecheckpass(result);
  459. end;
  460. function is_self_node(p:tnode):boolean;
  461. begin
  462. is_self_node:=(p.nodetype=loadn) and
  463. (tloadnode(p).symtableentry.typ=paravarsym) and
  464. (vo_is_self in tparavarsym(tloadnode(p).symtableentry).varoptions);
  465. end;
  466. { this function must return a very high value ("infinity") for }
  467. { trees containing a call, the rest can be balanced more or less }
  468. { at will, probably best mainly in terms of required memory }
  469. { accesses }
  470. function node_complexity(p: tnode): cardinal;
  471. var
  472. correction: byte;
  473. {$ifdef ARM}
  474. dummy : byte;
  475. {$endif ARM}
  476. begin
  477. result := 0;
  478. while assigned(p) do
  479. begin
  480. case p.nodetype of
  481. { floating point constants usually need loading from memory }
  482. realconstn,
  483. setconstn,
  484. stringconstn,
  485. temprefn,
  486. loadvmtaddrn,
  487. { main reason for the next one: we can't take the address of }
  488. { loadparentfpnode, so replacing it by a temp which is the }
  489. { address of this node's location and then dereferencing }
  490. { doesn't work. If changed, check whether webtbs/tw0935 }
  491. { still works with nodeinlining (JM) }
  492. loadparentfpn:
  493. begin
  494. result := 1;
  495. exit;
  496. end;
  497. loadn:
  498. begin
  499. if assigned(tloadnode(p).left) then
  500. inc(result,node_complexity(tloadnode(p).left));
  501. { threadvars need a helper call }
  502. if (tloadnode(p).symtableentry.typ=staticvarsym) and
  503. (vo_is_thread_var in tstaticvarsym(tloadnode(p).symtableentry).varoptions) then
  504. inc(result,5)
  505. else
  506. inc(result);
  507. if (result >= NODE_COMPLEXITY_INF) then
  508. result := NODE_COMPLEXITY_INF;
  509. exit;
  510. end;
  511. subscriptn:
  512. begin
  513. if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) then
  514. inc(result,2);
  515. if (result = NODE_COMPLEXITY_INF) then
  516. exit;
  517. p := tunarynode(p).left;
  518. end;
  519. blockn,
  520. callparan:
  521. p := tunarynode(p).left;
  522. notn,
  523. derefn :
  524. begin
  525. inc(result);
  526. if (result = NODE_COMPLEXITY_INF) then
  527. exit;
  528. p := tunarynode(p).left;
  529. end;
  530. typeconvn:
  531. begin
  532. { may be more complex in some cases }
  533. if not(ttypeconvnode(p).convtype in [tc_equal,tc_int_2_int,tc_bool_2_bool,tc_real_2_real,tc_cord_2_pointer]) then
  534. inc(result);
  535. if (result = NODE_COMPLEXITY_INF) then
  536. exit;
  537. p := tunarynode(p).left;
  538. end;
  539. vecn,
  540. statementn:
  541. begin
  542. inc(result,node_complexity(tbinarynode(p).left));
  543. if (result >= NODE_COMPLEXITY_INF) then
  544. begin
  545. result := NODE_COMPLEXITY_INF;
  546. exit;
  547. end;
  548. p := tbinarynode(p).right;
  549. end;
  550. addn,subn,orn,andn,xorn,muln,divn,modn,symdifn,
  551. shln,shrn,
  552. equaln,unequaln,gtn,gten,ltn,lten,
  553. assignn:
  554. begin
  555. {$ifdef CPU64BITALU}
  556. correction:=1;
  557. {$else CPU64BITALU}
  558. correction:=2;
  559. {$endif CPU64BITALU}
  560. inc(result,node_complexity(tbinarynode(p).left)+1*correction);
  561. if (p.nodetype in [muln,divn,modn]) then
  562. inc(result,5*correction*correction);
  563. if (result >= NODE_COMPLEXITY_INF) then
  564. begin
  565. result := NODE_COMPLEXITY_INF;
  566. exit;
  567. end;
  568. p := tbinarynode(p).right;
  569. end;
  570. ordconstn:
  571. begin
  572. {$ifdef ARM}
  573. if not(is_shifter_const(tordconstnode(p).value.svalue,dummy)) then
  574. result:=2;
  575. {$endif ARM}
  576. exit;
  577. end;
  578. tempcreaten,
  579. tempdeleten,
  580. pointerconstn,
  581. nothingn,
  582. niln:
  583. exit;
  584. inlinen:
  585. begin
  586. { this code assumes that the inline node has }
  587. { already been firstpassed, and consequently }
  588. { that inline nodes which are transformed into }
  589. { calls already have been transformed }
  590. case tinlinenode(p).inlinenumber of
  591. in_lo_qword,
  592. in_hi_qword,
  593. in_lo_long,
  594. in_hi_long,
  595. in_lo_word,
  596. in_hi_word,
  597. in_length_x,
  598. in_assigned_x,
  599. in_pred_x,
  600. in_succ_x,
  601. in_round_real,
  602. in_trunc_real,
  603. in_int_real,
  604. in_frac_real,
  605. in_cos_real,
  606. in_sin_real,
  607. in_arctan_real,
  608. in_pi_real,
  609. in_abs_real,
  610. in_sqr_real,
  611. in_sqrt_real,
  612. in_ln_real,
  613. in_unaligned_x,
  614. in_prefetch_var:
  615. begin
  616. inc(result);
  617. p:=tunarynode(p).left;
  618. end;
  619. in_abs_long:
  620. begin
  621. inc(result,3);
  622. if (result >= NODE_COMPLEXITY_INF) then
  623. begin
  624. result:=NODE_COMPLEXITY_INF;
  625. exit;
  626. end;
  627. p:=tunarynode(p).left;
  628. end;
  629. in_sizeof_x,
  630. in_typeof_x:
  631. begin
  632. inc(result);
  633. if (tinlinenode(p).left.nodetype<>typen) then
  634. { get instance vmt }
  635. p:=tunarynode(p).left
  636. else
  637. { type vmt = global symbol, result is }
  638. { already increased above }
  639. exit;
  640. end;
  641. {$ifdef SUPPORT_MMX}
  642. in_mmx_pcmpeqb..in_mmx_pcmpgtw,
  643. {$endif SUPPORT_MMX}
  644. { load from global symbol }
  645. in_typeinfo_x,
  646. { load frame pointer }
  647. in_get_frame,
  648. in_get_caller_frame,
  649. in_get_caller_addr:
  650. begin
  651. inc(result);
  652. exit;
  653. end;
  654. in_inc_x,
  655. in_dec_x,
  656. in_include_x_y,
  657. in_exclude_x_y,
  658. in_assert_x_y :
  659. begin
  660. { operation (add, sub, or, and }
  661. inc(result);
  662. { left expression }
  663. inc(result,node_complexity(tcallparanode(tunarynode(p).left).left));
  664. if (result >= NODE_COMPLEXITY_INF) then
  665. begin
  666. result := NODE_COMPLEXITY_INF;
  667. exit;
  668. end;
  669. p:=tcallparanode(tunarynode(p).left).right;
  670. if assigned(p) then
  671. p:=tcallparanode(p).left;
  672. end;
  673. else
  674. begin
  675. result := NODE_COMPLEXITY_INF;
  676. exit;
  677. end;
  678. end;
  679. end;
  680. else
  681. begin
  682. result := NODE_COMPLEXITY_INF;
  683. exit;
  684. end;
  685. end;
  686. end;
  687. end;
  688. { this function returns an indication how much fpu registers
  689. will be required.
  690. Note: The algorithms need to be pessimistic to prevent a
  691. fpu stack overflow on i386 }
  692. function node_resources_fpu(p: tnode): cardinal;
  693. var
  694. res1,res2,res3 : cardinal;
  695. begin
  696. result:=0;
  697. res1:=0;
  698. res2:=0;
  699. res3:=0;
  700. if p.inheritsfrom(tunarynode) then
  701. begin
  702. if assigned(tunarynode(p).left) then
  703. res1:=node_resources_fpu(tunarynode(p).left);
  704. if p.inheritsfrom(tbinarynode) then
  705. begin
  706. if assigned(tbinarynode(p).right) then
  707. res2:=node_resources_fpu(tbinarynode(p).right);
  708. if p.inheritsfrom(ttertiarynode) and assigned(ttertiarynode(p).third) then
  709. res3:=node_resources_fpu(ttertiarynode(p).third)
  710. end;
  711. end;
  712. result:=max(max(res1,res2),res3);
  713. case p.nodetype of
  714. calln:
  715. { it could be a recursive call, so we never really know the number of used fpu registers }
  716. result:=maxfpuregs;
  717. realconstn,
  718. typeconvn,
  719. loadn :
  720. begin
  721. if p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER] then
  722. result:=max(result,1);
  723. end;
  724. assignn,
  725. addn,subn,muln,slashn,
  726. equaln,unequaln,gtn,gten,ltn,lten :
  727. begin
  728. if (tbinarynode(p).left.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) or
  729. (tbinarynode(p).right.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER])then
  730. result:=max(result,2);
  731. if(p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) then
  732. inc(result);
  733. end;
  734. end;
  735. end;
  736. function setnodefilepos(var n: tnode; arg: pointer): foreachnoderesult;
  737. begin
  738. result:=fen_true;
  739. n.fileinfo:=pfileposinfo(arg)^;
  740. end;
  741. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  742. begin
  743. foreachnodestatic(n,@setnodefilepos,@filepos);
  744. end;
  745. function callsimplify(var n: tnode; arg: pointer): foreachnoderesult;
  746. var
  747. hn : tnode;
  748. treechanged : ^boolean;
  749. begin
  750. result:=fen_false;
  751. if n.inheritsfrom(tloopnode) and
  752. not (lnf_simplify_processing in tloopnode(n).loopflags) then
  753. begin
  754. // Try to simplify condition
  755. doinlinesimplify(tloopnode(n).left);
  756. // call directly second part below,
  757. // which might change the loopnode into
  758. // something else if the conditino is a constant node
  759. include(tloopnode(n).loopflags,lnf_simplify_processing);
  760. callsimplify(n,arg);
  761. // Be careful, n might have change node type
  762. if n.inheritsfrom(tloopnode) then
  763. exclude(tloopnode(n).loopflags,lnf_simplify_processing);
  764. end
  765. else
  766. begin
  767. hn:=n.simplify(true);
  768. if assigned(hn) then
  769. begin
  770. treechanged := arg;
  771. if assigned(treechanged) then
  772. treechanged^:=true
  773. else
  774. internalerror (201008181);
  775. n.free;
  776. n:=hn;
  777. typecheckpass(n);
  778. end;
  779. end;
  780. end;
  781. { tries to simplify the given node calling the simplify method recursively }
  782. procedure doinlinesimplify(var n : tnode);
  783. var
  784. treechanged : boolean;
  785. begin
  786. // Optimize if code first
  787. repeat
  788. treechanged:=false;
  789. foreachnodestatic(pm_postandagain,n,@callsimplify,@treechanged);
  790. until not(treechanged);
  791. end;
  792. function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
  793. begin
  794. if not forinline then
  795. result:=genintconstnode(value)
  796. else
  797. result:=cordconstnode.create(value,def,cs_check_range in current_settings.localswitches);
  798. end;
  799. function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
  800. var
  801. hpropsym : tpropertysym;
  802. begin
  803. result:=false;
  804. { find property in the overridden list }
  805. hpropsym:=propsym;
  806. repeat
  807. propaccesslist:=hpropsym.propaccesslist[pap];
  808. if not propaccesslist.empty then
  809. begin
  810. result:=true;
  811. exit;
  812. end;
  813. hpropsym:=hpropsym.overriddenpropsym;
  814. until not assigned(hpropsym);
  815. end;
  816. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  817. var
  818. plist : ppropaccesslistitem;
  819. begin
  820. plist:=pl.firstsym;
  821. while assigned(plist) do
  822. begin
  823. case plist^.sltype of
  824. sl_load :
  825. begin
  826. addsymref(plist^.sym);
  827. if not assigned(st) then
  828. st:=plist^.sym.owner;
  829. if (plist^.sym.typ<>staticvarsym) then
  830. begin
  831. { p1 can already contain the loadnode of
  832. the class variable. When there is no tree yet we
  833. may need to load it for with or objects }
  834. if not assigned(p1) then
  835. begin
  836. case st.symtabletype of
  837. withsymtable :
  838. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  839. ObjectSymtable :
  840. p1:=load_self_node;
  841. end;
  842. end
  843. end
  844. else
  845. begin
  846. p1.free;
  847. p1:=nil;
  848. end;
  849. if assigned(p1) then
  850. p1:=csubscriptnode.create(plist^.sym,p1)
  851. else
  852. p1:=cloadnode.create(plist^.sym,st);
  853. end;
  854. sl_subscript :
  855. begin
  856. addsymref(plist^.sym);
  857. p1:=csubscriptnode.create(plist^.sym,p1);
  858. end;
  859. sl_typeconv :
  860. p1:=ctypeconvnode.create_explicit(p1,plist^.def);
  861. sl_absolutetype :
  862. begin
  863. p1:=ctypeconvnode.create(p1,plist^.def);
  864. include(p1.flags,nf_absolute);
  865. end;
  866. sl_vec :
  867. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,plist^.valuedef,true));
  868. else
  869. internalerror(200110205);
  870. end;
  871. plist:=plist^.next;
  872. end;
  873. end;
  874. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  875. var
  876. sl : tpropaccesslist;
  877. procedure addnode(p:tnode);
  878. begin
  879. case p.nodetype of
  880. subscriptn :
  881. begin
  882. addnode(tsubscriptnode(p).left);
  883. sl.addsym(sl_subscript,tsubscriptnode(p).vs);
  884. end;
  885. typeconvn :
  886. begin
  887. addnode(ttypeconvnode(p).left);
  888. if nf_absolute in ttypeconvnode(p).flags then
  889. sl.addtype(sl_absolutetype,ttypeconvnode(p).totypedef)
  890. else
  891. sl.addtype(sl_typeconv,ttypeconvnode(p).totypedef);
  892. end;
  893. vecn :
  894. begin
  895. addnode(tvecnode(p).left);
  896. if tvecnode(p).right.nodetype=ordconstn then
  897. sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value,tvecnode(p).right.resultdef)
  898. else
  899. begin
  900. Message(parser_e_illegal_expression);
  901. { recovery }
  902. sl.addconst(sl_vec,0,tvecnode(p).right.resultdef);
  903. end;
  904. end;
  905. loadn :
  906. sl.addsym(sl_load,tloadnode(p).symtableentry);
  907. else
  908. internalerror(200310282);
  909. end;
  910. end;
  911. begin
  912. sl:=tpropaccesslist.create;
  913. addnode(p1);
  914. result:=sl;
  915. end;
  916. function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean;
  917. var
  918. static_name: shortstring;
  919. srsymtable: tsymtable;
  920. begin
  921. result:=false;
  922. { generate access code }
  923. if (sp_static in sym.symoptions) then
  924. begin
  925. result:=true;
  926. if not nested then
  927. static_name:=lower(sym.owner.name^)+'_'+sym.name
  928. else
  929. static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
  930. if sym.owner.defowner.typ=objectdef then
  931. searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,true)
  932. else
  933. searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
  934. if assigned(sym) then
  935. check_hints(sym,sym.symoptions,sym.deprecatedmsg);
  936. p1.free;
  937. p1:=nil;
  938. { static syms are always stored as absolutevarsym to handle scope and storage properly }
  939. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  940. end;
  941. end;
  942. function is_bitpacked_access(n: tnode): boolean;
  943. begin
  944. case n.nodetype of
  945. vecn:
  946. result:=
  947. is_packed_array(tvecnode(n).left.resultdef) and
  948. { only orddefs and enumdefs are actually bitpacked. Don't consider
  949. e.g. an access to a 3-byte record as "bitpacked", since it
  950. isn't }
  951. (tvecnode(n).left.resultdef.typ in [orddef,enumdef]) and
  952. not(tarraydef(tvecnode(n).left.resultdef).elepackedbitsize in [8,16,32,64]);
  953. subscriptn:
  954. result:=
  955. is_packed_record_or_object(tsubscriptnode(n).left.resultdef) and
  956. { see above }
  957. (tsubscriptnode(n).vs.vardef.typ in [orddef,enumdef]) and
  958. (not(tsubscriptnode(n).vs.vardef.packedbitsize in [8,16,32,64]) or
  959. (tsubscriptnode(n).vs.fieldoffset mod 8 <> 0));
  960. else
  961. result:=false;
  962. end;
  963. end;
  964. function genloadfield(n: tnode; const fieldname: string): tnode;
  965. var
  966. vs : tsym;
  967. begin
  968. if not assigned(n.resultdef) then
  969. typecheckpass(n);
  970. vs:=tsym(tabstractrecorddef(n.resultdef).symtable.find(fieldname));
  971. if not assigned(vs) or
  972. (vs.typ<>fieldvarsym) then
  973. internalerror(2010061902);
  974. result:=csubscriptnode.create(vs,n);
  975. end;
  976. function has_no_code(n : tnode) : boolean;
  977. begin
  978. if n=nil then
  979. begin
  980. result:=true;
  981. exit;
  982. end;
  983. result:=false;
  984. case n.nodetype of
  985. nothingn:
  986. begin
  987. result:=true;
  988. exit;
  989. end;
  990. blockn:
  991. begin
  992. result:=has_no_code(tblocknode(n).left);
  993. exit;
  994. end;
  995. statementn:
  996. begin
  997. repeat
  998. result:=has_no_code(tstatementnode(n).left);
  999. n:=tstatementnode(n).right;
  1000. until not(result) or not assigned(n);
  1001. exit;
  1002. end;
  1003. end;
  1004. end;
  1005. function check_for_sideeffect(var n: tnode; arg: pointer): foreachnoderesult;
  1006. begin
  1007. result:=fen_false;
  1008. if (n.nodetype in [assignn,calln,asmn]) or
  1009. ((n.nodetype=inlinen) and
  1010. (tinlinenode(n).inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string,
  1011. in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,in_settextbuf_file_x,
  1012. in_inc_x,in_dec_x,in_include_x_y,in_exclude_x_y,in_break,in_continue,in_setlength_x,
  1013. in_finalize_x,in_new_x,in_dispose_x,in_exit,in_copy_x,in_initialize_x,in_leave,in_cycle])
  1014. ) then
  1015. result:=fen_norecurse_true;
  1016. end;
  1017. function might_have_sideeffects(n : tnode) : boolean;
  1018. begin
  1019. result:=foreachnodestatic(n,@check_for_sideeffect,nil);
  1020. end;
  1021. var
  1022. nodecount : dword;
  1023. function donodecount(var n: tnode; arg: pointer): foreachnoderesult;
  1024. begin
  1025. inc(nodecount);
  1026. result:=fen_false;
  1027. end;
  1028. { rough estimation how large the tree "node" is }
  1029. function node_count(node : tnode) : dword;
  1030. begin
  1031. nodecount:=0;
  1032. foreachnodestatic(node,@donodecount,nil);
  1033. result:=nodecount;
  1034. end;
  1035. function trash_tempref(node : tnode) : tnode;
  1036. var
  1037. trashintval: aint;
  1038. begin
  1039. if node.nodetype<>tempcreaten then
  1040. internalerror(2012051901);
  1041. trashintval := trashintvalues[localvartrashing];
  1042. case ttempcreatenode(node).size of
  1043. 0: ; { empty record }
  1044. 1: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
  1045. ctypeconvnode.create_internal(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),ttempcreatenode(node).tempinfo^.typedef));
  1046. 2: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
  1047. ctypeconvnode.create_internal(cordconstnode.create(word(trashintval),u16inttype,false),ttempcreatenode(node).tempinfo^.typedef));
  1048. 4: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
  1049. ctypeconvnode.create_internal(cordconstnode.create(dword(trashintval),u32inttype,false),ttempcreatenode(node).tempinfo^.typedef));
  1050. 8: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
  1051. ctypeconvnode.create_internal(cordconstnode.create(qword(trashintval),u64inttype,false),ttempcreatenode(node).tempinfo^.typedef));
  1052. else
  1053. begin
  1054. result:=ccallnode.createintern('fpc_fillmem',
  1055. ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
  1056. ccallparanode.Create(cordconstnode.create(ttempcreatenode(node).size,uinttype,false),
  1057. ccallparanode.Create(ctemprefnode.create(ttempcreatenode(node)),nil)))
  1058. );
  1059. end;
  1060. end;
  1061. end;
  1062. end.